STITLE EXAL 5.0
xROMID 4C4
INCLUDE exext.h
ASSEMBLE
=exalcfg
RPL
::
# 4C4 TOSRRP
;
ASSEMBLE
CON(1) 8
RPL
xNAME SPRD
::
$ "FNT" palparse DROP ROMPTR@
ITE
DROP
::
$ "UFL not found!" xKILL
;
ClrDA1IsStat % 500 ' ID NUMBER STO xRCLF DUP ' ID FLGS STO CARCOMP
' ID SETTINGS @ NOT
ITE
HXS 10 0000000000000000
::
DUPTYPELIST?
IT
::
INCOMPDROP ' ID Times STO
;
;
TWO{}N xSTOF FORTY ClrSysFlag TWENTYTWO SetSysFlag TWENTYONE
SetSysFlag ONE ClrSysFlag TWO ClrSysFlag ID PT TYPEIDNT?
IT
::
ZEROZERO TWO{}N ' ID GPOS STO ZEROZERO EX3A THREE{}N ' ID TP8
STO ZERO EIGHT TWO{}N ' ID PT STO $ "UNNAMED" ' ID NAMES STO EX35
;
EX39 EX40 EX37 EX54 EX36 ID FLGS xSTOF ' ID FLGS PURGE ' ID NUMBER PURGE
;
ASSEMBLE
CON(1) 8
RPL
xNAME PLOTTER
::
CK2&Dispatch
#55
::
EX70 SWAP EX70 SWAP OVER TYPELIST? OVER TYPELIST? AND
IT
EX6F
;
;
ASSEMBLE
CON(1) 8
RPL
xNAME ABOUT
::
RECLAIMDISP ClrDA1IsStat DOCLLCD TURNMENUOFF
GROB 23A 41000C6000000000CF0300000303FF3000CF00000000CF0300000303FF3000CF000000003033000003033000003030000000303300000303300000303000000030330000030330000030300000003033000003033000003030CF0303303300000303FF00003C30CF0303303300000303FF00003C30303303FF33000003030030003330303303FF33000003030030003330FF3CC0303300000CC0003000F030FF3CC0303300000CC0003000F030300030303300000CC00030003030300030303300000CC00030003030300CC0303300000030303C303030300CC0303300000030303C303030CF0303303FF3000030CF0C30CF00CF0303303FF3000030CF0C30CF0000000000000000000000000000000000000000000000000000000000
$ " by Al Arduengo"
$ " April 25, 97 "
DISPROW7 DISPROW5 ABUFF TWELVE FIVE GROB! WaitForKey 2DROP
RECLAIMDISP
;
NULLNAME EX03
::
DUPTYPEIDNT?
IT
::
ID>$ DUP DUP CAR$ CHR># SIXTYFOUR OVER #< SWAP # 5B #< AND OVER CAR$ CHR>#
SIXTYFOUR #- ID M_ CARCOMP LENCOMP #1+ #< AND SWAP CDR$
DUP NULL$? NOT
IT
DOSTR>
DUPTYPEREAL?
ITE
::
ID M_ LENCOMP #1+ UNCOERCE %<
;
DROPFALSE
AND
ITE
::
EX51 INCOMPDROP COERCE2 EX58
DUPTYPELIST?
IT
::
TWO NTHCOMPDROP
;
;
$>ID
;
LAM US SWAP >TCOMP ' LAM US STOLAM
;
***********************************************************************
NULLNAME EX04
::
TURNMENUOFF
$ "------------NO" $ "SHIFT-----------" $ "[ON] Exit"
$ " [*] TOGBar" $ "[STO] Sto SHT" $ " [+] +Col"
$ "['] FRM ENT" $ " [-] +Row" $ "[EVAL] RCLC SHT"
$ " [SPC] RDRW" $ "[VAR] Make Var" $ " [/] FRM/VAL"
$ "[F] SDev" $ " [\8E] STK\8D" $ "[E] Mean"
$ " [DEL] DEL" $ "[D] TOT" $ " [EEX] Grid"
$ "[C] Copy" $ " [ENTER] \8DSTK"
TWENTY EX6E
$ "-----------Left" $ "Shift-----------" $ "[0] STD"
$ " [2] Fix2" $ "[3] Fix3" $ " [1/X] JUST\8E\8D"
$ "[-] -Row" $ " [+] -Col" $ "[VIEW] EQView"
$ " [/] CMPLX" $ "[EVAL] RCLC Cell" $ " [+/-] Edit"
$ "['] RCLC\90\8F" $ " [NXT] Info" $ "[TAN] Save \85DAT"
$ " [\8D] Move\8F\8D"
SIXTEEN EX6E
$ "-----------Right"
$ "Shift-----------" $ "[\90] [\8E] [\8F] [\8D]" $ " Jump"
$ "[TAN] +\85" $ " [EVAL] #RCLC" $ "[-] $ ENT"
$ " [0] \8DGLBL" $ "[SPC] Toggle" $ "AutoAdj"
TEN EX6E
;
***********************************************************************
NULLNAME EX05
::
RECLAIMDISP TOADISP EX40 EX50 EX5B EX40 TOGDISP THIRTYFIVE
UserITE EX49 EX4E
;
***********************************************************************
NULLNAME EX06
::
$ " " SWAP TWO ZEROZERO EX05
;
***********************************************************************
NULLNAME EX07
::
SIX DUP UserITE ClrUserFlag SetUserFlag
;
***********************************************************************
NULLNAME EX08
GROB 11A 800003800000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
***********************************************************************
NULLNAME EX09
::
BEGIN
::
REPEATERCH SEVENTEEN EX49 TRUE
;
UNTIL
;
***********************************************************************
NULLNAME EX0A
::
DUPTYPELIST? IT CARCOMP EX61 DUPTYPEIDNT? IT
xEVAL EX56 EX51 INCOMPDROP COERCE2 EX5A EX5B
;
***********************************************************************
NULLNAME EX0B
::
BEGIN
::
REPEATERCH SIXTEEN EX4C TRUE
;
UNTIL
;
***********************************************************************
NULLNAME EX0C
::
NINE SetUserFlag $ "Copy " ' ID BR STO ZERO EX0D
;
***********************************************************************
NULLNAME EX0D
::
EX3A EX60 DUP THREE
#<case
::
ID BR EX56 &$ EX5F EX33
;
DUP THREE
#=case
::
DROP ' ID BR PURGE EX4B
;
FOUR
#=case
::
' ID BR PURGE
;
;
***********************************************************************
NULLNAME EX0E
::
BEGIN
::
REPEATERCH EIGHTEEN EX4E TRUE
;
UNTIL
;
***********************************************************************
NULLNAME EX0F
::
BEGIN
::
REPEATERCH ELEVEN EX4F TRUE
;
UNTIL
;
***********************************************************************
NULLNAME EX10
::
RECLAIMDISP TOADISP EX45 TOGDISP
;
***********************************************************
NULLNAME EX11
::
LAM CPY EX51 INCOMPDROP COERCE2 EX58
DUPTYPELIST?
IT
::
CARCOMP LAM CPY CAR$ CHR># LAM FRM CAR$ CHR># #=
ITE
::
LAM FRM CDR$ DOSTR> LAM CPY CDR$ DOSTR> %- COERCE DUP
ZERO #<>
ITE
::
ONE SetUserFlag SWAP DUPTYPESYMB?
ITE
::
SWAP #1+ ONE DO EX1C LOOP
;
::
SWAP #1+ ONE DO EX1E LOOP
;
ONE ClrUserFlag
;
DROP
;
::
LAM FRM CAR$ CHR># LAM CPY CAR$ CHR># #- ONE ClrUserFlag SWAP
DUPTYPESYMB?
ITE
::
SWAP #1+ ONE DO EX1C LOOP
;
::
SWAP #1+ ONE DO EX1E LOOP
;
LAM FRM CDR$ DOSTR> LAM CPY CDR$ DOSTR> %- COERCE DUP #0<>
ITE
::
ONE SetUserFlag SWAP DUPTYPESYMB? ITE
::
SWAP #1+ ONE DO EX1C LOOP
;
::
SWAP #1+ ONE DO EX1E LOOP
;
ONE ClrUserFlag
;
DROP
;
;
;
***********************************************************************
NULLNAME EX12
::
EX56 EX51 INCOMPDROP COERCE2 EX58
;
***********************************************************************
NULLNAME EX13
::
%1 a%>$ LEN$ #1- SWAP DUPLEN$ ROT #- ONE SWAP SUB$
;
**********************************************************************
**********************************************************************
NULLNAME BEEPER
::
% 2000 % .2 xBEEP
;
**********************************************************************
NULLNAME EX14
::
ID M_ CARCOMP LENCOMP FOUR #= ITE
BEEPER
::
EX43 RECLAIMDISP TOADISP KILLGDISP DOCLLCD $ " Deleting Column..."
DISPROW3 FORTYTWO SetUserFlag ID PT CARCOMP THIRTYTHREE #/
SWAPDROP #1+ DUP UNCOERCE ' ID NUMBER STO 1LAMBIND ID M_ INNERCOMP
#1+ ONE DO INNERCOMP reversym 1GETLAM #1+ ROLL DROP #1- reversym
{}N ISTOP@ #1- ROLL LOOP ID M_ LENCOMP {}N ID M_ REPLACE DROP
1GETLAM ID M_ CARCOMP LENCOMP #> IT
::
ID GPOS INCOMPDROP THIRTYTHREE #- TWO {}N ID GPOS REPLACE DROP ID PT
INCOMPDROP SWAP THIRTYTHREE #- SWAP TWO {}N ID PT REPLACE DROP
;
ABND EX39 THIRTYSIX TestUserFlag IT
EX6B EX40 FORTYTWO ClrUserFlag % 500 ' ID NUMBER STO EX37
;
;
***********************************************************************
NULLNAME EX15
::
EX40 EX12 TYPECSTR? NOT IT
::
THIRTEEN SetUserFlag
;
$ " " EX48 EX5B EX40
;
***********************************************************************
NULLNAME EX16
::
ID M_ LENCOMP EIGHT #= ITE
BEEPER
::
EX43 RECLAIMDISP TOADISP KILLGDISP DOCLLCD $ " Deleting Row..."
DISPROW3 THIRTYTWO SetUserFlag ID PT TWO NTHCOMPDROP EIGHT #/
SWAPDROP DUP UNCOERCE ' ID NUMBER STO 1LAMBIND ID M_ INNERCOMP
reversym 1GETABND #1+ ROLL DROP #1- reversym {}N ID M_ REPLACE
DROP ID PT INCOMPDROP SWAPDROP EIGHT #<> IT
::
ID PT INCOMPDROP EIGHT #- TWO{}N ' ID PT STO
;
EX39 THIRTYSIX TestUserFlag IT
EX6B EX40 THIRTYTWO ClrUserFlag % 500 ' ID NUMBER STO EX37
;
;
***********************************************************************
NULLNAME EX17
::
TakeOver RECLAIMDISP EX40 EX12 DUPTYPELIST? IT CARCOMP TOADISP ObEdit
IT
::
EX12 TYPECSTR? NOT IT
::
THIRTEEN SetUserFlag
;
ERRSET CK1 ERRTRAP $ "Error!" EX61 DUPTYPELIST? IT
::
THIRTEEN SetUserFlag
;
ID PT INCOMPDROP EX44 #1- EX5A
;
TOGDISP EX5B EX40
;
***********************************************************************
NULLNAME EX18
::
EX43 RECLAIMDISP TRUE ' LAM EXIT STOLAM
;
***********************************************************************
NULLNAME EX19
::
SEVENTEEN DUP TestUserFlag ITE ClrUserFlag SetUserFlag
ID TP8 INCOMPDROP GBUFF UNROT GROB!
;
***********************************************************************
NULLNAME EX1A
::
DEPTH #0<> IT
::
EX40 STRIPTAGS EX0A EX40
;
;
***********************************************************************
NULLNAME EX1B
::
RECLAIMDISP TOADISP EX04 TOGDISP
;
***********************************************************************
NULLNAME EX1C
::
EXPLODE DUP
{
LAM COUNT
}
BIND #1+ ONE DO LAM COUNT ROLL DUPTYPEIDNT? IT
::
ID>$ DUP CAR$ CHR># THIRTYSIX #<> IT
::
ONE TestUserFlag ITE EX52 EX53
;
$>ID
;
LOOP
LAM COUNT IMPLODE ABND
;
***********************************************************************
NULLNAME EX1D
::
EX43 RECLAIMDISP TOADISP KILLGDISP DOCLLCD $ " Inserting Col..."
DISPROW3 FORTYONE SetUserFlag ID M_ INNERCOMP EX56 CAR$ CHR># SIXTYFOUR
#- DUP UNCOERCE ' ID NUMBER STO
{
LAM KNT
LAM COLP
}
BIND LAM KNT #1+ ONE DO ISTOP@ #1- ROLL NULL$ LAM COLP EX2E LOOP
ID M_ LENCOMP {}N ID M_ REPLACE DROP ABND EX39 THIRTYSIX TestUserFlag
IT EX6B EX40 FORTYONE ClrUserFlag % 500 ' ID NUMBER STO EX37
;
***********************************************************************
NULLNAME EX1E
::
INNERCOMP DUP
{
LAM COUNT
}
BIND #1+ ONE DO LAM COUNT ROLL DUPTYPEIDNT? IT
::
ID>$ DUP CAR$ CHR># THIRTYSIX #<> IT
::
ONE TestUserFlag ITE EX52 EX53
;
$>ID
;
LOOP LAM COUNT ::N ABND
;
***********************************************************************
NULLNAME EX1F
::
EX43 RECLAIMDISP TOADISP KILLGDISP DOCLLCD $ " Inserting Row..."
DISPROW3 THIRTYONE SetUserFlag ID M_ DUP CARCOMP LENCOMP DUP
1LAMBIND #1+ ONE DO $ "" LOOP 1GETABND {}N EX56 EX51 TWO NTHCOMPDROP
DUP ' ID NUMBER STO COERCE EX2E ID M_ REPLACE DROP EX39 THIRTYSIX
TestUserFlag IT EX6B EX40 % 500 ' ID NUMBER STO THIRTYONE ClrUserFlag EX37
;
***********************************************************************
NULLNAME EX20
::
EX40 EX38 JUMPBOT EX3D CARCOMP GBUFF GROBDIM DROP EIGHT #-
TWO{}N ' ID PT STO EX40 EX37
;
***********************************************************************
NULLNAME EX21
::
EX40 EX38 JUMPLEFT EX3D ZERO SWAP TWO NTHCOMPDROP TWO{}N '
ID PT STO EX40 EX37
;
***********************************************************************
NULLNAME EX22
::
JUMPRIGHT EX40 EX38 EX3D TWO NTHCOMPDROP GBUFF GROBDIM SWAPDROP
THIRTYTHREE #- SWAP TWO{}N ID PT REPLACE DROP EX40 EX37
;
***********************************************************************
NULLNAME EX23
::
EX40 EX38 JUMPTOP EX3D CARCOMP EIGHT TWO{}N ID PT REPLACE DROP
EX40 EX37
;
***********************************************************************
NULLNAME EX24
::
{
ID SETTINGS
ID TP8
ID GPOS
ID PT
ID NAMES
ID Times
}
xPURGE
' ID M_ PURGE
;
***********************************************************************
NULLNAME EX25
::
DUP ID M_ ID PT ID GPOS ID TP8 xRCLF TWO NTHCOMPDROP ' ID Times @
IT TWO{}N '
::
' ID SETTINGS STO ' ID TP8 STO ' ID GPOS STO ' ID PT STO ' ID M_ STO
' ID NAMES STO xSPRD
;
SEVEN ::N SWAP $ ".S" &$ $>ID STO
;
***********************************************************************
NULLNAME EX26
::
CK3&Dispatch
# 333
::
{
LAM CPY
LAM FRM
LAM goto
}
BIND
EX5E LAM FRM LAM goto 2DUP CAR$ CHR># SWAP CAR$ CHR># SWAP #> ROT CDR$ DOSTR>
ROT CDR$ DOSTR> %> OR ITE
::
TOADISP DOCLLCD $ " Invalid Limits!" FlashWarning TOGDISP
;
::
THIRTEEN SetUserFlag EX40 EX38 LAM goto CAR$ CHR># LAM FRM CAR$ CHR># #- #1+
#1+ ONE DO EX11 LAM FRM DUP CAR$ LAM goto CDR$ &$
EX4D LAM FRM ' LAM CPY STO LAM FRM DUP CAR$ SWAP CDR$
&$ ' LAM FRM STO LOOP EX5B EX37 EX40
;
ABND
;
;
***********************************************************************
NULLNAME EX27
::
ID TOTLST DUPTYPELIST?
ITE
::
DUPLENCOMP #1= ITE
::
INCOMPDROP EX0A
;
::
INNERCOMP
{
LAM SZ
}
BIND LAM SZ #1- #1+ ONE DO x+ LOOP LAM SZ ABND UNCOERCE x/ EX0A
;
;
DROP
;
***********************************************************************
NULLNAME EX28
::
ID TOTLST DUPTYPELIST?
ITE
::
DUPLENCOMP #1= ITE DROP
::
LENCOMP #1-
{
LAM SZ
}
BIND
%1 LAM SZ UNCOERCE x/ ID TOTLST INCOMPDROP LAM SZ #1+ ONE DO
x+ LOOP LAM SZ #1+ UNCOERCE x/
{
LAM MEN
}
BIND ID TOTLST INNERCOMP #1+ ONE DO LAM MEN x- xSQ LAM SZ #1+ ROLL
LOOP LAM SZ #1+ ONE DO x+ LOOP x* xSQRT ABND ABND EX0A
;
;
DROP
;
***********************************************************************
NULLNAME EX29
::
ID TOTLST DUPTYPELIST?
ITE
::
DUPLENCOMP #1= ITE
::
INCOMPDROP EX0A
;
::
INNERCOMP #1- #1+ ONE DO x+ LOOP EX0A
;
;
DROP
;
***********************************************************************
NULLNAME EX2A
::
EX43 RECLAIMDISP TOADISP KILLGDISP EX39
;
***********************************************************************
NULLNAME EX2B
::
TOADISP $ "JUSTSAVE" EX36 TOGDISP
;
***********************************************************************
NULLNAME EX2C
::
RECLAIMDISP TOADISP EX3E TOGDISP
;
***********************************************************************
NULLNAME EX2D
::
EX12 DUPTYPELIST? IT
::
TWO NTHCOMPDROP
;
DUPTYPEREAL? OVER TYPECMP? OR
ITE
::
$ "$" EX56 &$ $>ID STO
;
DROP
;
***********************************************************************
NULLNAME EX2E
::
SWAPROT INNERCOMP #1+DUP #1+ROLL OVERDUP #3+ ROLL #- #2+UNROLL {}N
;
***********************************************************************
NULLNAME EX2F
::
# 0
{
LAM NUMB
}
BIND EX12 DUPTYPELIST?
ITE
::
CARCOMP ONE ' LAM NUMB STOLAM
;
::
DUPTYPEREAL? OVER TYPECMP? OR NOT
ITE
DROP
::
ONE ' LAM NUMB STOLAM
;
;
LAM NUMB #1=
IT
::
ID TOTLST DUPTYPEIDNT?
IT
::
DROP NULL{} ' ID TOTLST STO ID TOTLST
;
INNERCOMP #1+ {}N ' ID TOTLST STO
;
ABND
;
***********************************************************************
NULLNAME EX30
::
EX12 EX56 x->TAG
;
***********************************************************************
NULLNAME EX31
::
THIRTEEN DUP TestUserFlag
ITE
ClrUserFlag
DROP
$ " Recalculating.... "
EX5F VERYSLOW EX38 EX40 ID Times DUPTYPEREAL?
ITE
COERCE
::
DROP ZERO
;
#1+ ONE
DO
EX46
LOOP
EX40
;
***********************************************************************
NULLNAME EX32
::
$ "AGROB" palparse DROP ROMPTR@ IT
::
DROP
TOADISP DOCLLCD TURNMENUOFF EX12 DUPTYPELIST?
ITE
::
CARCOMP DUPTYPESYMB?
ITE
::
%1 $ "AGROB" DOSTR>
;
DO>STR
;
DO>STR $ "VV" DOSTR> DROP RECLAIMDISP TOGDISP
;
;
***********************************************************************
NULLNAME EX33
::
WaitForKey DROP TWENTYFIVE
OVER#=case
::
DROP ZERO
OVER#=case
::
DROP ID BR EX56 &$ $ " from " &$ ID BR REPLACE DROP EX56 ONE EX0D
;
ONE
OVER#=case
::
DROP ID BR EX56 &$ $ " thru " &$ ID BR REPLACE DROP EX56 TWO EX0D
;
TWO
#=case
::
EX56 THREE EX0D
;
;
FORTYFIVE
OVER#=case
::
DROP NDROP NINE ClrUserFlag FOUR EX0D
;
ELEVEN
OVER#=case
::
DROP EX0F EX0D
;
SIXTEEN
OVER#=case
::
DROP EX0B EX0D
;
SEVENTEEN
OVER#=case
::
DROP EX09 EX0D
;
EIGHTEEN
OVER#=case
::
DROP EX0E EX0D
;
DROP % 2200 % .05 xBEEP EX0D
;
***********************************************************************
NULLNAME EX38
::
ID TP8 INCOMPDROP GBUFF UNROT GROB!
;
***********************************************************************
NULLNAME EX3B
::
SEVENTEEN TestUserFlag NOT
IT
::
EX3A EX60 EX56 DUP $ " :" &$ SWAP EX51 INCOMPDROP COERCE2 EX58
DUPTYPELIST?
IT
::
SIX
TestUserFlag
ITE
::
TWO NTHCOMPDROP
;
CARCOMP
;
DO>STR &$ DUP SGROB DUPGROBDIM SWAPDROP # 81 #>
ITE
::
DROP DUPLEN$ THIRTYTHREE #>
IT
::
ONE THIRTYONE SUB$ $ ".." &$
;
SGROB
;
SWAPDROP GBUFF WINDOWCORNER #2+ SWAP #1+ GROB!
;
THIRTEEN TestUserFlag
IT
SetAlphaAnn
;
***********************************************************************
NULLNAME EX3C
::
NULL{}
{
LAM EQ
LAM US
}
BIND LAM EQ INNERCOMP {}N ' LAM EQ STOLAM LAM EQ LENCOMP #1+ ONE
DO
LAM EQ INDEX@ NTHCOMPDROP
EX03
LOOP
DEPTH #1+ 1LAMBIND
ERRSET
::
LAM US INNERCOMP ::N EVAL
;
ERRTRAP
$ "ERROR!"
ERRSET
::
DEPTH #0=
IT
$ "Error!"
DUPTYPEREAL? OVER TYPECMP? OR OVER TYPECSTR? OR NOT
IT
$ "Error!"
;
ERRTRAP
$ "ERROR!" LAM EQ INNERCOMP ::N SWAP TWO{}N DEPTH 1GETLAM #<>
IT
::
DEPTH 1GETABND #- #1+ ONE
DO
SWAPDROP
LOOP
;
ABND
INCOMPDROP
;
***********************************************************************
NULLNAME EX3D
ID PT
***********************************************************************
NULLNAME EX3E
::
$ "Enter name for data..."
$ ""
TWO ZERO TWO EX42
IT
::
ERRSET
::
xOBJ> ID TOTLST DUPTYPELIST?
ITE
::
SWAP STO ' ID TOTLST PURGE
;
::
DOCLLCD $ "NO CURRENT \85DAT" DISPROW3 VERYSLOW
;
;
ERRTRAP
NOP
;
;
***********************************************************************
NULLNAME EX3F
::
EX40 EX3D INCOMPDROP
;
***********************************************************************
NULLNAME EX41
::
EX47 GBUFF 4ROLL 4ROLL GROB! EX5B
;
***********************************************************************
NULLNAME EX42
::
TWELVE TestUserFlag
ITE
ONE
ZERO
EditMenu ONE TRUE ZERO InputLine TWELVE ClrUserFlag
;
***********************************************************************
NULLNAME EX43
::
WINDOWCORNER TWO{}N ID GPOS REPLACE DROP
;
***********************************************************************
NULLNAME EX44
::
EIGHT #/ #1+ SWAPDROP SWAP THIRTYTHREE #/ #1+ SWAPDROP SWAP
;
***********************************************************************
NULLNAME EX45
::
$ "Enter info..." $ ":contents:\n: name:" ELEVEN ZERO ZERO EX42
IT
::
$ "Wait..." DISPROW3 xOBJ> xEVAL ID>$ $ "$" SWAP &$ $>ID SWAP xEVAL
SWAP STO
;
;
***********************************************************************
NULLNAME EX46
::
NULL{} ' ID ELE STO ID M_ INNERCOMP FOURTEEN TestUserFlag NOT
IT
reversym #1+ ONE
DO
BEGIN
DUPTYPELIST? NOT
ITE
::
DROPFALSE
;
TRUE
UNTIL
ID ELE REPLACE DROP ID ELE LENCOMP #1+ ONE
DO
ID ELE INDEX@ NTHCOMPDROP DUPTYPELIST?
ITE
::
SetAlphaAnn CARCOMP EX61 DUP TWO NTHCOMPDROP DO>STR EX57 EX62 SGROB
SIX THIRTYONE MAKEGROB GBUFF INDEX@ #1- THIRTYTHREE #* #1+ JINDEX@
FOURTEEN TestUserFlag
IT
::
ID M_ LENCOMP SWAP#- #1+
;
EIGHT #* #1+ THREE NDUP 7ROLL 4UNROLL GROB! GROB! ClrAlphaAnn INDEX@
JINDEX@ FOURTEEN TestUserFlag
IT
::
ID M_ LENCOMP SWAP#- #1+
;
EX5A
;
DROP
LOOP
LOOP
EX5B ' ID ELE PURGE
;
***********************************************************************
NULLNAME EX47
::
NULL{}
{
LAM EQ
LAM US
}
BIND LAM EQ INNERCOMP {}N ' LAM EQ STOLAM LAM EQ LENCOMP #1+ ONE
DO
LAM EQ INDEX@ NTHCOMPDROP
EX03
LOOP
DEPTH #1+ 1LAMBIND
ERRSET
::
LAM US INNERCOMP IMPLODE CRUNCH DUPTYPECSTR?
IT
::
DROP $ "Error!"
;
;
ERRTRAP
$ "Error!" LAM EQ INNERCOMP IMPLODE SWAP TWO{}N DEPTH 1GETLAM #<>
IT
::
DEPTH 1GETABND #- #1+ ONE
DO
SWAPDROP
LOOP
;
ABND
INCOMPDROP
;
***********************************************************************
NULLNAME EX48
::
EX56 EX51 INCOMPDROP COERCE2 EX5A EX5B
;
***********************************************************************
NULLNAME EX49
::
ID PT TWO NTHCOMPDROP GBUFF GROBDIM DROP SWAP SIXTEEN #+ #< NOT
IT
::
EX40 ID PT INCOMPDROP EIGHT #+ TWO{}N ID PT REPLACE DROP EX40
BOTROW EX3D TWO NTHCOMPDROP #<
IT
::
EX38 EIGHT #1+ ONE
DO
WINDOWDOWN
LOOP
EX37
;
;
;
***********************************************************************
NULLNAME EX4A
::
INNERDUP
{
LAM COUNT
}
BIND #1+ ONE
DO
LAM COUNT ROLL DUPTYPEIDNT?
IT
::
ID>$ DUP CAR$ CHR># THIRTYSIX #<>
ITE
::
ONE TestUserFlag
ITE
EX52
EX53
$>ID
;
$>ID
;
LOOP
LAM COUNT ::N ABND
;
***********************************************************************
NULLNAME EX4B
::
EX26
;
***********************************************************************
NULLNAME EX4C
::
ID PT CARCOMP ZERO #<>
IT
::
EX40 ID PT INCOMPDROP SWAP THIRTYTHREE #- SWAP TWO{}N ID PT REPLACE
DROP EX40 LEFTCOL ID PT CARCOMP #>
IT
::
EX38 THIRTYTHREE #1+ ONE
DO
WINDOWLEFT
LOOP
EX37
;
;
;
***********************************************************************
NULLNAME EX4D
::
ONE SetUserFlag ROT ' ID COPE STO
{
LAM STRT
LAM STOP
}
BIND
LAM STOP CDR$ DOSTR> LAM STRT CDR$ DOSTR> %- COERCE #1+ #1+ ONE
DO
SetAlphaAnn ' ID COPE @ DROP EX61 DUPTYPELIST?
ITE
::
DUP TWO NTHCOMPDROP
;
DUP DO>STR EX57 EX62 SGROB SIX THIRTYONE MAKEGROB GBUFF LAM STRT
EX51 INCOMPDROP COERCE2 SWAP #1- THIRTYTHREE #* #1+ SWAP EIGHT #*
#1+ THREE NDUP 7ROLL 4UNROLL GROB! GROB! ClrAlphaAnn LAM STRT EX51
INCOMPDROP COERCE2 EX5A LAM STRT EX52 ' LAM STRT STOLAM ' ID COPE
@ DROP DUPTYPESYMB?
IT
EX1C
DUPTYPECOL?
IT
EX1E
' ID COPE @ DROP REPLACE DROP
LOOP
' ID COPE PURGE ABND ONE ClrUserFlag
;
***********************************************************************
NULLNAME EX4E
::
ID PT CARCOMP GBUFF GROBDIM SWAPDROP SWAP FOURTWO #+ #< NOT
IT
::
EX40 ID PT INCOMPDROP SWAP THIRTYTHREE #+ SWAP TWO{}N ID PT
REPLACE DROP EX40 RIGHTCOL ID PT CARCOMP #<
IT
::
EX38 THIRTYTHREE #1+ ONE
DO
WINDOWRIGHT
LOOP
EX37
;
;
;
***********************************************************************
NULLNAME EX4F
::
ID PT TWO NTHCOMPDROP EIGHT #>
IT
::
EX40 ID PT INCOMPDROP EIGHT #- TWO{}N ID PT REPLACE DROP TOPROW
#8+ ID PT TWO NTHCOMPDROP #>
IT
::
EX38 EIGHT #1+ ONE
DO
WINDOWUP
LOOP
EX37
;
EX40
;
;
***********************************************************************
NULLNAME EX50
::
CK5
EX42
IT
::
EX12 ClrDA1IsStat TYPECSTR? NOT
IT
::
THIRTEEN SetUserFlag
;
ERRSET
::
TWELVE TestUserFlag NOT
IT
DOSTR>
CK1
;
ERRTRAP
$ "Error!" DUPTYPELIST?
ITE
EX6C
::
DUPTYPESYMB?
IT
xEVAL
DUPTYPEIDNT?
IT
::
DUP
ERRSET
::
xRCL SWAPDROP
;
ERRTRAP
NOP
;
EX61 EX56 EX51 INCOMPDROP COERCE2 EX5A
;
;
;
***********************************************************************
NULLNAME EX51
::
DUP xNUM % 64 %- SWAP CDR$ palparse DROP TWO{}N
;
***********************************************************************
NULLNAME EX52
::
DUP CAR$ CHR>$ SWAP CDR$ palparse DROP %1+ a%>$ &$
;
***********************************************************************
NULLNAME EX53
::
DUP CAR$ CHR># #1+ #>CHR CHR>$ SWAP CDR$ &$
;
***********************************************************************
NULLNAME EX54
::
FALSE
{
LAM EXIT
}
BIND
' EX3B '
::
ONE
#=casedrop
::
ONE
?CaseKeyDef
::
xTICKS ID TIME1 DUPTYPEIDNT?
ITE
::
$ " Timer on "
EX5F VERYSLOW VERYSLOW STO
;
::
$ " Timer off "
EX5F x- HXS>% % 8192 %/ EX0E EX0A EX40 EX0B EX09 ' ID TIME1
PURGE
;
;
TWENTYSEVEN
?CaseKeyDef
::
THIRTY DUP TestUserFlag ITE ClrUserFlag SetUserFlag
EX38 EX5D EX5C EX37
;
FIFTEEN
?CaseKeyDef
EX31
THIRTEEN
?CaseKeyDef
::
$ "Enter formula for "
EX56 &$ $ "''" TWO ZERO TWO EX05
;
FORTYSIX
?CaseKeyDef
::
$ "0" EX06
;
THIRTYONE
?CaseKeyDef
::
$ "7" EX06
;
THIRTYTWO
?CaseKeyDef
::
$ "8" EX06
;
THIRTYTHREE
?CaseKeyDef
::
$ "9" EX06
;
THIRTYSIX
?CaseKeyDef
::
$ "4" EX06
;
THIRTYSEVEN
?CaseKeyDef
::
$ "5" EX06
;
THIRTYEIGHT
?CaseKeyDef
::
$ "6" EX06
;
FORTYONE
?CaseKeyDef
::
$ "1" EX06
;
FORTYTWO
?CaseKeyDef
::
$ "2" EX06
;
FORTYTHREE
?CaseKeyDef
::
$ "3" EX06
;
FORTYSEVEN
?CaseKeyDef
::
$ "." EX06
;
TWO
?CaseKeyDef
EX74
THREE
?CaseKeyDef
EX0C
FOUR
?CaseKeyDef
EX29
FIVE
?CaseKeyDef
EX27
SIX
?CaseKeyDef
EX28
TEN
?CaseKeyDef
EX10
FOURTEEN
?CaseKeyDef
EX2B
TWELVE
?CaseKeyDef
::
TOADISP EX04 TOGDISP
;
TWENTYNINE
?CaseKeyDef
EX1A
TWENTYEIGHT
?CaseKeyDef
EX15
ELEVEN
?CaseKeyDef
EX0F
SIXTEEN
?CaseKeyDef
EX0B
SEVENTEEN
?CaseKeyDef
EX09
EIGHTEEN
?CaseKeyDef
EX0E
TWENTYFIVE
?CaseKeyDef
EX30
THIRTYFOUR
?CaseKeyDef
EX07
THIRTYNINE
?CaseKeyDef
EX19
FORTYFOUR
?CaseKeyDef
EX1F
FORTYFIVE
?CaseKeyDef
::
TWELVE SetUserFlag EX18 TWELVE ClrUserFlag
;
FORTYSIX
?CaseKeyDef
EX2D
FORTYEIGHT
?CaseKeyDef
::
EX2A EX40
;
FORTYNINE
?CaseKeyDef
EX1D
THIRTYFIVE
#=casedrpfls
FORTY
#=casedrpfls
DROP
'DoBadKeyT
;
TWO
#=casedrop
::
THIRTYTWO
?CaseKeyDef
::
THIRTYNINE DUP TestUserFlag
ITE
::
ClrUserFlag
$ " Plot points "
;
::
SetUserFlag
$ " Plot lines "
;
EX5F VERYSLOW VERYSLOW
;
SEVEN
?CaseKeyDef
::
SEVENTEEN DUP TestSysFlag ITE ClrSysFlag SetSysFlag EX2A EX40
;
EIGHTEEN
?CaseKeyDef
::
THIRTYFIVE DUP TestUserFlag
ITE
::
ClrUserFlag
$ " Move right "
;
::
SetUserFlag
$ " Move down "
;
EX5F VERYSLOW VERYSLOW
;
TWENTYFOUR
?CaseKeyDef
::
TWENTY DUP TestUserFlag
ITE
::
ClrUserFlag
$ " Justify left "
;
::
SetUserFlag
$ " Justify right "
;
EX5F VERYSLOW VERYSLOW EX2A EX40
;
FORTYSIX
?CaseKeyDef
::
xSTD EX2A EX40
;
FORTYTWO
?CaseKeyDef
::
%2 xFIX EX2A EX40
;
FORTYTHREE
?CaseKeyDef
::
%3 xFIX EX2A EX40
;
THIRTEEN
?CaseKeyDef
::
FOURTEEN DUP TestUserFlag
ITE
::
ClrUserFlag
$ " Recalculate \8F "
;
::
SetUserFlag
$ " Recalculate \90 "
;
EX5F VERYSLOW VERYSLOW
;
TWENTYSIX
?CaseKeyDef
EX17
THIRTYFOUR
?CaseKeyDef
::
$ "()" EX06
;
FIFTEEN
?CaseKeyDef
::
EX12 DUPTYPELIST?
ITE
::
EX40 CARCOMP EX61 DUP TWO NTHCOMPDROP DO>STR EX57 EX62 SGROB
GBUFF ID PT INCOMPDROP #1+ SWAP #1+ SWAP GROB! EX56 EX51 INCOMPDROP
COERCE2 EX5A EX5B EX40
;
DROP
;
SEVENTEEN
?CaseKeyDef
EX32
TWELVE
?CaseKeyDef
EX6D
TWENTYONE
?CaseKeyDef
EX2C
FORTYFOUR
?CaseKeyDef
EX16
FORTYNINE
?CaseKeyDef
EX14
THIRTYFIVE
#=casedrpfls
DROP
'DoBadKeyT
;
THREE
#=casedrop
::
THIRTYTWO
?CaseKeyDef
::
TOADISP xPLOTTER TOGDISP
;
SEVEN
?CaseKeyDef
::
SIXTEEN DUP TestSysFlag ITE ClrSysFlag SetSysFlag EX2A EX40
;
FORTYEIGHT
?CaseKeyDef
::
THIRTYSIX DUP TestUserFlag
ITE
::
ClrUserFlag
$ " Don't update "
;
::
SetUserFlag
$ " Update "
;
EX5F VERYSLOW VERYSLOW
;
FIFTEEN
?CaseKeyDef
::
TOADISP RECLAIMDISP $ "Evaluate n times" NULL$ ONE ZEROZERO
ZERO NULL{} ONE TRUE TWO
InputLine
IT
::
' ID Times STO
;
TOGDISP
;
TWENTYONE
?CaseKeyDef
EX2F
FORTYSIX
?CaseKeyDef
::
EX12 DUPTYPELIST?
IT
CARCOMP
EX56 $ "$" SWAP &$ $>ID STO
;
FORTYFOUR
?CaseKeyDef
::
TWELVE SetUserFlag $ "Enter string for " EX56 &$ CHR_DblQuote
CHR>$ DUP &$ TWO ZEROZERO EX05 TWELVE ClrUserFlag
;
ELEVEN
?CaseKeyDef
EX23
SIXTEEN
?CaseKeyDef
EX21
SEVENTEEN
?CaseKeyDef
EX20
EIGHTEEN
?CaseKeyDef
EX22
FORTY
#=casedrpfls
DROP
'DoBadKeyT
;
2DROP
'DoBadKeyT
;
TrueTrue NULL{} ONEFALSE ' LAM EXIT ' ERRJMP ParOuterLoop KILLGDISP
ABND ClrDAsOK $ "LEAVE"
;
***********************************************************************
NULLNAME EX55
::
EX1D GBUFF EX3D INCOMPDROP GROB! EX5B
;
***********************************************************************
NULLNAME EX56
::
ID PT INCOMPDROP EX44 SWAP UNCOERCE2 % 64 %+ xCHR SWAP %1 %- a%>$
&$ EX13
;
***********************************************************************
NULLNAME EX57
::
DUPLEN$ EIGHT #>
IT
::
ONE SIX SUB$ $ ".." &$
;
;
***********************************************************************
NULLNAME EX58
::
2DUP ID M_ LENCOMP #> SWAP ID M_ CARCOMP LENCOMP #> OR
ITE
::
DROP DROP $ "INVLD CELL!"
;
::
ID M_ SWAP NTHCOMPDROP SWAP NTHCOMPDROP
;
;
***********************************************************************
NULLNAME EX59
::
ID M_ INNERCOMP reversym #1+ ONE
DO
INNERCOMP reversym #1+ ONE
DO
DUPTYPECSTR? NOT OVER TYPELIST? NOT AND
IT
DO>STR
DUPTYPELIST?
IT
::
TWO NTHCOMPDROP DO>STR
;
EX57 EX62 SGROB GBUFF INDEX@ #1- THIRTYTHREE #* #1+ JINDEX@ EIGHT
#* #1+ GROB!
LOOP
LOOP
;
***********************************************************************
NULLNAME EX5A
::
{
LAM OB
LAM XB
LAM YB
}
BIND
ID M_ INNERCOMP reversym DROP LAM YB ROLL LAM OB SWAP LAM XB SWAP PUTLIST
LAM YB UNROLL ID M_ LENCOMP reversym {}N ID M_ REPLACE DROP ABND
;
***********************************************************************
NULLNAME EX5B
::
SEVEN THIRTYTWO MAKEGROB GBUFF ID PT INCOMPDROP GROB! ID PT INCOMPDROP
EIGHT #- EX44 EX58 DUPTYPELIST?
IT
::
TWO NTHCOMPDROP
;
DUPTYPECSTR? NOT IT DO>STR
EX57 EX62 SGROB GBUFF ID PT INCOMPDROP #1+ SWAP #1+ SWAP GROB!
;
***********************************************************************
NULLNAME EX5C
::
ID M_ LENCOMP #1+ ONE
DO
ZERO INDEX@ #1+ EIGHT #* #1- GBUFF GROBDIM SWAPDROP OVER ORDERXY#
TOGLINE3
LOOP
;
***********************************************************************
NULLNAME EX5D
::
ID M_ CARCOMP LENCOMP #1+ ONE DO INDEX@ THIRTYTHREE #* DUP #0<>
IT #1- DUP EIGHT GBUFF GROBDIM DROP ROTSWAP ORDERXY# TOGLINE3
LOOP
;
***********************************************************************
NULLNAME EX5E
::
EX08 EX60
;
***********************************************************************
NULLNAME EX5F
::
SGROB INVGROB GBUFF WINDOWCORNER #1+ SWAP #1+ GROB!
;
***********************************************************************
NULLNAME EX60
::
GBUFF WINDOWCORNER SWAP GROB!
;
***********************************************************************
NULLNAME EX61
::
DUPTYPESYMB?
IT
::
EX47 EX63
;
DUPTYPECOL?
IT
::
EX3C EX63
;
;
***********************************************************************
NULLNAME EX62
::
TWENTY TestUserFlag
IT
::
DUPLEN$ SEVEN #<
IT
::
DUPLEN$ SEVEN SWAP #- #1+ ONE
DO
$ " " SWAP&$
LOOP
;
;
;
***********************************************************************
NULLNAME EX63
::
DUPTYPEREAL?
IT
::
DUP % 9.9E399 %>
ITE
::
DROP $ " inf "
;
::
DUP % -9.9E399 %<
IT
::
DROP $ " -inf "
;
;
;
TWO {}N
;
***********************************************************************
NULLNAME EX64
::
INNERCOMP DUP
{
LAM COUNT
}
BIND #1+ ONE
DO
LAM COUNT ROLL DUPTYPEIDNT?
IT
::
ID>$ DUP CAR$ CHR># THIRTYSIX #<>
IT
EX65
$>ID
;
LOOP
LAM COUNT ::N ABND
;
***********************************************************************
NULLNAME EX65
::
THIRTYONE TestUserFlag
ITE
EX68
::
THIRTYTWO TestUserFlag
ITE
EX6A
::
FORTYONE TestUserFlag
ITE EX67 EX69
;
;
;
***********************************************************************
NULLNAME EX66
::
EXPLODE DUP
{
LAM COUNT
}
BIND #1+ ONE
DO
LAM COUNT ROLL DUPTYPEIDNT?
IT
::
ID>$ DUP CAR$ CHR># THIRTYSIX #<> IT EX65 $>ID
;
LOOP
LAM COUNT IMPLODE ABND
;
***********************************************************************
NULLNAME EX67
::
DUP CAR$ CHR># DUP SIXTYTHREE #- ID NUMBER COERCE #> IT #1+ #>CHR SWAP CDR$ &$
;
***********************************************************************
NULLNAME EX68
::
DUP CAR$ CHR>$ SWAP CDR$ palparse DROP DUP ID NUMBER %>
IT %1+ a%>$ &$
;
***********************************************************************
NULLNAME EX69
::
DUP CAR$ CHR># DUP SIXTYTHREE #- ID NUMBER COERCE #> IT #1- #>CHR SWAP CDR$ &$
;
***********************************************************************
NULLNAME EX6A
::
DUP CAR$ CHR>$ SWAP CDR$ palparse DROP DUP ID NUMBER %>
IT %1- a%>$ &$
;
***********************************************************************
NULLNAME EX6B
::
NULL{} ' ID ELE STO ID M_ INNERCOMP FOURTEEN TestUserFlag NOT
IT reversym #1+ ONE DO BEGIN DUPTYPELIST? NOT ITE DROPFALSE
TRUE UNTIL
ID ELE REPLACE DROP ID ELE LENCOMP #1+ ONE DO
ID ELE INDEX@ NTHCOMPDROP DUPTYPELIST? ITE
::
SetAlphaAnn CARCOMP DUPTYPESYMB?
ITE EX66 EX64 EX61 DUP TWO NTHCOMPDROP DO>STR EX57 EX62 SGROB
SIX THIRTYONE MAKEGROB GBUFF INDEX@ #1- THIRTYTHREE #* #1+
JINDEX@ FOURTEEN TestUserFlag IT
::
ID M_ LENCOMP SWAP#- #1+
;
EIGHT #* #1+ THREE NDUP 7ROLL 4UNROLL GROB! GROB! ClrAlphaAnn INDEX@
JINDEX@ FOURTEEN TestUserFlag
IT
::
ID M_ LENCOMP SWAP#- #1+
;
EX5A
;
DROP
LOOP
LOOP
EX5B ' ID ELE PURGE
;
***********************************************************************
NULLNAME EX6C
::
DUPNULL{}? NOT
IT
::
ID PT ' ID PTB STO INNERCOMP reversym ID PT INCOMPDROP THIRTYFIVE
TestUserFlag
ITE
::
SWAPDROP EIGHT #/ SWAPDROP #1- ID M_ LENCOMP SWAP #- #MIN
;
::
DROP THIRTYTHREE #/ SWAPDROP ID M_ CARCOMP LENCOMP SWAP #- #MIN
;
#1+ ONE DO DUPTYPESYMB? IT xEVAL DUPTYPEIDNT? IT xRCL
EX61 EX56 EX51 INCOMPDROP COERCE2 EX5A EX5B ID PT INCOMPDROP
THIRTYFIVE TestUserFlag ITE #8+
::
SWAP THIRTYTHREE #+ SWAP
;
TWO{}N ID PT REPLACE DROP
LOOP
ID PTB ID PT REPLACE DROP ' ID PTB PURGE
;
;
***********************************************************************
NULLNAME EX6D
::
TOADISP TURNMENUOFF DOCLLCD THIRTYSIX TestUserFlag
ITE
$ "Update " $ "Don't update "
THIRTYFIVE TestUserFlag
ITE
$ "Move down" $ "Move right"
THIRTYNINE TestUserFlag
ITE
$ "Plot lines" $ "Plot points"
TWENTYFIVE TestUserFlag
ITE
$ "Justify right" $ "Justify left"
FOURTEEN TestUserFlag
ITE
$ "Recalculate up" $ "Recalculate down"
' ID Times @
ITE
::
$ " [" SWAP DO>STR &$ EX13 $ "]" &$ &$
;
::
$ " [1]" &$
;
SIX TestUserFlag
ITE
$ "Don't show formulas" $ "Show formulas"
SEVENTEEN TestUserFlag
ITE
$ "No status bar" $ "Status bar"
ID M_ DUPLENCOMP SWAP CARCOMP LENCOMP UNCOERCE2 $ "Cols: "
SWAP a%>$ EX13 &$ $ " Rows: " ROT a%>$ EX13 &$ &$ $ "Size of "
ID NAMES &$ $ ": " &$ ID M_ xBYTES SWAPDROP DO>STR EX13 &$ xMEM
$ "Mem avail: " SWAP DO>STR EX13 &$ %2 a%>$ DUP EX13 LEN$ SWAP LEN$
SWAP #- DUP #0=
ITE
::
DROP $ " STD"
;
::
#1- UNCOERCE a%>$ EX13 $ " xFIX " SWAP&$
;
&$ TEN #1+ ONE DO SGROB ZERO INDEX@ #1- #6* ROT XYGROBDISP LOOP
WaitForKey DROP DROP RECLAIMDISP TOGDISP
;
***********************************************************************
NULLNAME EX6E
::
reversym TWO #/ SWAPDROP DOCLLCD #1+ ONE DO
SGROB ZERO INDEX@ #1- #6* ROT XYGROBDISP SGROB BINT_65d INDEX@
#1- #6* ROT XYGROBDISP LOOP WaitForKey DROP DROP
;
***********************************************************************
NULLNAME EX71
::
CK2&Dispatch
#33
::
{
LAM XL
LAM XR
}
BIND LAM XR CDR$ DOSTR> LAM XL CDR$ DOSTR> 2DUP %MAX %1+ ROT ROT
%MIN COERCE2 DO LAM XR CAR$ CHR># SIXTYFOUR #- LAM XL CAR$ CHR># SIXTYFOUR #- UNCOERCE2
TWO{}N SORT INCOMPDROP %1+ SWAP COERCE2 DO ID M_ JINDEX@ NTHCOMPDROP INDEX@ NTHCOMPDROP
LOOP LAM XR CAR$ CHR># LAM XL CAR$ CHR># #- DUP #0= NOT ITE
::
#1+ {}N
;
DROP LOOP LAM XR CDR$ DOSTR> LAM XL CDR$ DOSTR> %- %ABS DUP %0= NOT
ITE
::
%1+ COERCE {}N
;
DROP ABND
;
;
***********************************************************************
NULLNAME EX72
::
WaitForKey DROP TWENTYFIVE
OVER#=case
::
DROP ZERO
OVER#=case
::
DROP ID BR EX56 &$ $ " Through " &$ ID BR REPLACE DROP EX56 ONE EX73
;
ONE
#=case
::
EX56 TWO EX73
;
;
FORTYFIVE
OVER#=case
::
DROP NDROP NINE ClrUserFlag THREE EX73
;
ELEVEN
OVER#=case
::
DROP EX0F EX73
;
SIXTEEN
OVER#=case
::
DROP EX0B EX73
;
SEVENTEEN
OVER#=case
::
DROP EX09 EX73
;
EIGHTEEN
OVER#=case
::
DROP EX0E EX73
;
DROP BEEPER EX73
;
***********************************************************************
NULLNAME EX73
::
EX3A EX60 DUP TWO
#<case
::
ID BR EX56 &$ EX5F EX72
;
DUP TWO
#=case
::
DROP ' ID BR PURGE EX71
;
THREE
#=case
::
' ID BR PURGE
;
;
***********************************************************************
NULLNAME EX74
::
NINE SetUserFlag $ "Extract " ' ID BR STO ZERO EX73
;
****************************************************************
NULLNAME SORT
::
CK1&Dispatch
FIVE
::
INNERCOMP DUP1LAMBIND #1+ ONE DO 1GETLAM ROLL ZERO INDEX@
BEGIN 2DUP SWAP#- #2/ DUP#0<> WHILE
::
OVERSWAP #-DUP #4+PICK 5PICK %> ITE ROTDROPSWAP SWAPDROP
;
REPEAT ROT2DROP UNROLL LOOP 1GETABND {}N
;
;
NULLNAME EX34
EX61
* Creates a new sheet with 4 cols and 9 rows
NULLNAME EX35
::
{
$ ""
$ ""
$ ""
$ ""
}
SEVEN #1+ ONE DO DUP LOOP EIGHT {}N ' ID M_ STO
;
************************************************************************
* This routine saves the current sheet and data to var
************************************************************************
NULLNAME EX36
::
RECLAIMDISP $ "Save sheet as.." ID NAMES TYPECSTR? NOT ITE $ "Unnamed"
ID NAMES DUPLEN$ #1+ ZERO ZERO TWELVE SetUserFlag EX42 IT
EX25 $ "JUSTSAVE" EQUAL NOT IT EX24 TWELVE ClrUserFlag
;
***********************************************************************
* Stores the databox grob to a global var
************************************************************************
NULLNAME EX37
::
GBUFF WINDOWCORNER SWAP OVER BINT_131d #+ OVER #8+ SUBGROB
WINDOWCORNER SWAP THREE {}N ' ID TP8 STO
;
***********************************************************************
* Creates a xBLANK grob sized according to sheet size
************************************************************************
NULLNAME EX39
::
ID M_ CARCOMP LENCOMP THIRTYTHREE
#* ID M_ LENCOMP EIGHT #* #8+ MAKEPICT# TOGDISP ID GPOS INCOMPDROP WINDOWXY
TURNMENUOFF ID PT INCOMPDROP GBUFF GROBDIM SWAP ROT #< UNROT #> OR
IT
::
ZERO EIGHT TWO{}N ' ID PT STO
;
EX59 THIRTY TestUserFlag
IT
::
EX37 EX5D EX5C EX38
;
;
**********************************************************************
* Grob of empty databox
************************************************************************
NULLNAME EX3A
GROB 11A 8000038000EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF30100000000000000000000000000000004010000000000000000000000000000000401000000000000000000000000000000040100000000000000000000000000000004010000000000000000000000000000000401000000000000000000000000000000040EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF30
**********************************************************************
* Toggles on/off the cursor
************************************************************************
NULLNAME EX40
::
ID PT INCOMPDROP 2DUP 2DUP #7+ SWAP THIRTYTWO #+ SWAP GBUFF 5UNROLL
SUBGROB INVGROB GBUFF 4ROLL 4ROLL GROB!
;
**********************************************************************
* Plotter routine
************************************************************************
NULLNAME EX6F
::
CK2&Dispatch
#55
::
DOCLLCD TURNMENUOFF DUP %0 EQUALPOSCOMP #0=
IT
::
%0 >HCOMP SWAP %0 >HCOMP SWAP
;
OVER SORT DUP CARCOMP SWAP DUPLENCOMP NTHCOMPDROP 3PICK SORT
DUP CARCOMP SWAP DUPLENCOMP NTHCOMPDROP 5PICK LENCOMP 7PICK LENCOMP
#MIN
{
LAM XD
LAM YD
LAM XLO
LAM XHI
LAM YLO
LAM YHI
LAM #_
}
BIND
LAM YHI LAM YLO %- % 63 %/ LAM XHI LAM XLO %- % 130 %/
{
LAM YR
LAM XR
}
BIND
ZERO LAM YHI LAM YLO %- LAM YLO %ABS %- LAM YR %/ DUP1LAMBIND COERCE
# 81 OVER LINEON LAM #_ #1+ ONE DO
% 130 LAM XHI LAM XD INDEX@ NTHCOMPDROP %- LAM XR %/ %- LAM YHI LAM YD
INDEX@ NTHCOMPDROP %- LAM YR %/ COERCE2 THIRTYNINE TestUserFlag
ITE
::
OVER 1GETLAM COERCE ORDERXY# LINEON
;
PIXON LOOP WaitForKey DROP DROP RECLAIMDISP ABND ABND ABND
;
;
***********************************************************************
* Process list for plotter, reals only!
************************************************************************
NULLNAME EX70
::
INNERCOMP DUP1LAMBIND #1+ ONE DO ISTOP@ #1- ROLL DUPTYPELIST? IT
::
TWO NTHCOMPDROP
;
LOOP NULL{} 1GETLAM #1+ ONE DO 1GETLAM #1+ INDEX@ #1- #- ROLL DUPTYPEREAL?
ITE
::
OVER TYPELIST? ITE >TCOMP DROP
;
::
DROP DROP %0
;
LOOP ABND
;
* This is strictly Jack Levy's code.
NULLNAME SGROB
::
CK1NOLASTWD DUPTYPECSTR? NcaseTYPEERR
DUPNULL$? casedrop NULLGROB ROMPTR 101 3
OVERLEN$ FOUR #* SIX SWAP MAKEGROB UNROT
CODE
A=DAT1 A * font address -> A[A]
A=A+CON A,10 *
R0=A.F A * body of font -> R0[A]
D1=D1+ 5 *
D=D+1 A *
A=DAT1 A *
R1=A.F A * string -> R1[A]
D1=D1+ 5 *
D=D+1 A *
GOSBVL =SAVPTR * save pointers with grob on stack
A=DAT1 A *
D0=A * grob -> D0
D0=D0+ 15 *
A=DAT0 A * pixel width -> A[A]
GOSBVL =w->W *
B=A A * row nibbles -> B[A]
D0=D0+ 5 * roll to body of grob
C=R1.F A *
GOSBVL =GetStrLenC *
D=C A * characters -> D[A], body -> D1
NextChr D=D-1 A *
GOC Quit * if no more characters, quit
C=0 A *
A=0 A *
A=DAT1 B * read character from string
C=R0.F A * recall address for body of font
A=A+A A *
C=C+A A *
C=C+A A *
C=C+A A *
CD0EX * font address for character -> D0
A=DAT0 6 * read data for this character
D0=C * grob address -> D0, C[A]
DrwChLp DAT0=A P * write data to screen
CD0EX *
C=C+B A * roll to next "row" of grob
CD0EX *
P=P+1 *
?P# 6 * finished yet?
GOYES DrwChLp *
P= 0 *
D0=C *
D0=D0+ 1 * advance to next pixel
D1=D1+ 2 * advance to next character
GOTO NextChr * jump back to start drawing
Quit GOVLNG =GETPTRLOOP * get pointers, restore inner loop
ENDCODE
;
****************************************************************
