Cowsay

cowsay.b

' **********************************************************************
' ***
' ***	cowsay.b	Moo
' ***			2017, Kelvin W Sherlock
' ***

#define	IDENT_PROG "cowsay"
#define	IDENT_VERS "1.0"
#define	IDENT_DATE "09apr17"
#define	IDENT_NAME "Kelvin_Sherlock"

#define EYE_COUNT 12
#define TONGUE_COUNT 2

#pragma declare 1

'#define DEBUG 
#ifdef DEBUG
#pragma optimize 2, 2
#endif

' md-basic bug -- generates garbage code if AccFil$ is 4th delcared variable.
#declare AccFile$, AccMode, AccOK
#declare argc, argv$ AppPath$,SysInfo$

#declare eyeList$, tongueList$
#declare msg$, eyes$, tongue$

#declare i, r, k, stdout$, info$

#include <BASIC.h>
#include <ProDOS.h>
#include <ProLine/ProLine.h>


	gosub AppInit
	gosub InitStdout


	eyeList$=`"ooOOOooO..==$$@@--XX^^**"`
	tongueList$=" U"

	msg$="moo"
	eyes$="oo"
	tongue$=" "

	if argc=1 then
		r = int(rnd(1) * EYE_COUNT)*2
		eyes$=mid$(eyeList$, r+1, 2)
		r = int(rnd(1) * TONGUE_COUNT)
		tongue$=mid$(tongueList$, r+1, 1)

		gosub ReadFortune

	else
		msg$=""
		for i=1 to argc-1
			msg$ = msg$ + argv$[i] + " "
		next i
		&spc(msg$),msg$
	endif 

	if stdout$>"" then fAppend stdout$
	gosub DrawText
	gosub DrawCow
	if stdout$>"" then fClose stdout$
	goto Exit


#declare l, w, begin$, end$, line,type%
#declare a$

#define TEXTWIDTH 36
DrawText:
	l = len(msg$)
	w = TEXTWIDTH

	if w > l then w = l

	' draw top line
	print left$(" ______________________________________",w+3)
	'print " ";
	'& hlin w+2,asc("_")
	'print


	begin$="</|\"
	end$=">\|/"

	line=1
	repeat
		gosub GetOneLine
		type%=3
		if line=1 then
			if msg$="" then
				type%=1
			else
				type%=2
			endif
		else
			if msg$="" then type%=4
		endif

		' pad a$ to width...
		& left$ (a$, w),a$
		print mid$(begin$, type%, 1) " " a$ " " mid$(end$, type%, 1)

		line=line+1

	until msg$=""


	' draw bottom line
	print left$(" --------------------------------------",w+3)

	'print " ";
	'& hlin w+2,asc("-")
	'print
	return

#declare xmsg$, p
GetOneLine:
	' in: msg$
	' out: a$, msg$

	&pos(msg$,"^N"),p
	if p>0 then
		a$=left$(msg$,p-1)
		msg$=mid$(msg$,p+1)
		' ugh... recursion :(
		if (len(a$)>TEXTWIDTH) then
			xmsg$=msg$
			msg$=a$
			gosub rr
			msg$=msg$ + "^N" + xmsg$
		endif
		return
	endif

	if len(msg$)<37 then
		a$=msg$
		msg$=""
		return
	endif

rr:

	&pos right$(TEXTWIDTH, msg$," "),p
	if p=0 then 
		a$=left$(msg$,TEXTWIDTH)
		msg$=mid$(msg$,TEXTWIDTH)
	else
		a$=left$(msg$,p-1)
		msg$=mid$(msg$,p+1)
	endif
	return

DrawCow:

	print `"        \   ^__^"` ' `...` to prevent ^ control chars. 
	print "         \  (" eyes$ ")\_______"
	print "            (__)\       )\/\"
	print "             " tongue$ "  ||----w |"
	print "                ||     ||"
	print ""
	return


#declare f$, GamesLib$, n, m, i, e, l
ReadFortune:

	GamesLib$ = GAMES_LIB_PATH

	& time(a$)
	r = rnd (-(val(mid$(a$,19)) * 60 + val(right$(a$,2)))) + rnd (-rnd(9))

	f$ = GamesLib$ + "fortunes"

	fOpen f$
	fRead f$
	poke _SREFNUM, peek(_OREFNUM)
	& MLI (_GET_EOF, _SGETEOF), i
	n = peek24(_SEOF)
	m = int(rnd(1) * n)
	onerr goto fortuneError

tryAgain:
	if m > 10 then
		poke24(_SMARK, m)
		& MLI (_SET_MARK, _SGETMRK), i
		& get 
	endif
	& get msg$
	fClose
	return

fortuneError:
	& onerr e,l
	if e = 5 then 
		m = m - 20
		if m > 10 then goto tryAgain
	endif
	fClose
	& print argv$[0]": error " e " at " l
	goto ExitError

InitStdout:
	if argc>1 then
		AccFile$ = argv$[argc-1]
		if asc(AccFile$)=62 then
			argc = argc - 1
			k = len(AccFile$)
			&spc(AccFile$,62),AccFile$ ' strip > chars
			k = k-len(AccFile$)

			' only need to check info/delete if > redirection
			info$=""
			if k=1 then & getinfo AccFile$,info$

			AccMode = accWrite + (info$>"") * accDelete 
			gosub CheckAccess
			if not AccOK then
				& print argv$[0] ": can't open " AccFile$
				goto ExitError
			endif

			stdout$ = AccFile$
			if info$>"" then fDelete stdout$
			'fAppend stdout$
		endif

	endif
	AccFile$=""
	return
	goto CheckAccess2 ' ### Alert: CHECKACCESS2 unused in CHECKACCESS

#include <ProLine/ProLine.lib>
#include <ProLine/Access.lib>