Amiga Format 42/af042b.adf/Extras.lha/Dataflex.AMOS/Dataflex.amosSourceCode

AMOS Source Code | 1992-02-21 | 15.3 KB | 680 lines

Set Buffer 30
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'                                 Dataflex
'
'              A simple card file indexer written in AMOS by
'
'                              Peter J.Hickman
'
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' File Format
'
' Number of current pages (up to 100) are contained in the first word.
'
' Each page uses 344 bytes.
'
' The first 14 bytes contain the title of the card.
' The second 30 bytes contain the first line of text.
' The third 30 bytes contain the second line of text.
'  "    "   "    "      "     "     "     "   "   "
'
' Variables
' ~~~~~~~~~
' NPAGES=Number of PAGES currently filled
' PAGENUM=Currently displayed page
' POS=The position (in bytes) of the cursor within the current page.
' TX=X position in pixels for text cursor
' TY=Y position in pixels for text cursor
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' Define main & Global Variables
'
NPAGES=1
PAGENUM=1
TX=40
TY=67
POS=0
INP$=" ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!�$%^&*()?/.><,#@:;}]{[|\+=_-0123456789~'`"+Chr$(34)
Global NPAGES,PAGENUM,TX,TY,INP$,POS
'
HOUSE_KEEP
'
TITLE_SCR
'
MAIN_SCR
'
DISPLAY_PAGE[1]
'
Repeat
   Repeat
      K$=""
      SCAN=0
      SSHIFT=0
      K$=Inkey$
      SCAN=Scancode
      SSHIFT=Key Shift
      If Mouse Zone>0 and Mouse Key>0
         On(Mouse Zone) Proc _LOAD,_SAVE,_PRINT,_SEARCH,_INSERT,_DELETE,_SORT,_DOWN,_UP
      End If
      If SCAN>=80 and SCAN<=86
         On(SCAN-79) Proc _LOAD,_SAVE,_PRINT,_SEARCH,_INSERT,_DELETE,_SORT
         SCAN=0
      End If
   Until K$<>"" or SCAN<>0
   '
   ' Up and down movement
   If Instr(INP$,K$)
      PT_CHAR[K$]
   Else
      '
      '
      ' Special control keyboard shortcuts
      '
      '
      If SCAN=78 and SSHIFT=8
         _UP
      End If
      If SCAN=79 and SSHIFT=8
         _DOWN
      End If
      If SSHIFT=0
         '
         '
         ' general cursor movement
         '
         '
         If SCAN=95
            _SORT
         End If
         If SCAN=68 and TY<190
            TX=40
            If TY=67
               TY=80
            Else
               Add TY,11
            End If
            D0_CUR
         End If
         If SCAN=77 and TY<190 and TY<>67
            Add TY,11
            D0_CUR
         End If
         If SCAN=76 and TY=80
            If TX>144
               TX=144
            End If
            TY=67
            D0_CUR
         End If
         If SCAN=77 and TY=67
            TY=80
            D0_CUR
         End If
         If SCAN=76 and TY>80
            Add TY,-11
            D0_CUR
         End If
         '
         ' Left and right movement
         If SCAN=78 and TX<144 and TY=67
            Add TX,8
            D0_CUR
         End If
         If SCAN=79 and TX>40 and TY=67
            Add TX,-8
            D0_CUR
         End If
         If SCAN=78 and TY>67 and TX<272
            Add TX,8
            D0_CUR
         End If
         If SCAN=79 and TY>67 and TX>40
            Add TX,-8
            D0_CUR
         End If
         If SCAN=65
            DEL_CHAR
         End If
      End If
   End If
Until False
Procedure _LOAD
   Bob 1,0,8,1
   While Mouse Key>0 : Wend
   Bob Off 1
   F$=Fsel$("*.DLX","","Select a cardfile to load")
   If F$<>""
      If Exist(F$)
         INIT_FILE
         Bload F$,Start(6)
         DISPLAY_PAGE[1]
      End If
   End If
   D0_CUR
End Proc
Procedure _SAVE
   Bob 1,46,8,2
   While Mouse Key>0 : Wend
   Bob Off 1
   F$=Fsel$("*.DLX","","Select a cardfile to save")
   If F$<>""
      Bsave F$,Start(6) To Start(6)+(Deek(Start(6))*344)+2
   End If
   D0_CUR
End Proc
Procedure _PRINT
   Bob 1,92,8,3
   While Mouse Key>0 : Wend
   Bob Off 1
   REQUEST["Do you wish","to print?","YES","NO"]
   If Param=1
      REQUEST["Print how","much?","ALL","CARD"]
      SIZE=Deek(Start(6))
      Lprint
      Lprint
      If Param=1
         For LOP1=1 To SIZE
            PPAGE[LOP1]
         Next LOP1
      Else
         PPAGE[PAGENUM]
      End If
   End If
End Proc
Procedure _PRINT_TO_DISK
   REQUEST["Do you wish","to ASC dump?","YES","NO"]
   If Param=1
      F$=Fsel$("","","")
      If F$<>""
         Open Out 2,F$
         SIZE=Deek(Start(6))
         Print #2,
         Print #2,
         For LOP1=1 To SIZE
            DISKPAGE[LOP1]
         Next LOP1
         Close
      End If
   End If
End Proc
Procedure PPAGE[NUM]
   BASE=Start(6)+(344*(NUM-1))+2
   Lprint "CARD";NUM
   Lprint
   Lprint "|------------------------------|"
   Lprint "|";
   For LOP=0 To 13
      Lprint Chr$(Peek(BASE+LOP));
   Next LOP
   Lprint "                |"
   Lprint "|------------------------------|"
   Lprint "|";
   For LOP=0 To 329
      Lprint Chr$(Peek(BASE+LOP+14));
      If(LOP+1) mod 30=False
         Lprint "|"
         Lprint "|";
      End If
   Next LOP
   Lprint "------------------------------|"
   Lprint
   Lprint
End Proc
Procedure DISKPAGE[NUM]
   BASE=Start(6)+(344*(NUM-1))+2
   Print #2,"CARD";NUM
   Print #2,
   Print #2,"|------------------------------|"
   Print #2,"|";
   For LOP=0 To 13
      Print #2,Chr$(Peek(BASE+LOP));
   Next LOP
   Print #2,"                |"
   Print #2,"|------------------------------|"
   Print #2,"|";
   For LOP=0 To 329
      Print #2,Chr$(Peek(BASE+LOP+14));
      If(LOP+1) mod 30=False
         Print #2,"|"
         Print #2,"|";
      End If
   Next LOP
   Print #2,"------------------------------|"
   Print #2,
   Print #2,
End Proc
Procedure _SEARCH
   Bob 1,138,8,4
   While Mouse Key>0 : Wend
   Bob Off 1
   REQUEST2["Search for","what?"]
   WORD$=Param$
   If WORD$<>""
      BASE=Start(6)+2
      BASEEND=Start(6)+(344*(Deek(Start(6))))+2
      TEMP=Hunt(BASE To BASEEND,WORD$)
      If TEMP>0
         TEMP=TEMP-BASE
         BPAGE=(TEMP/344)+1
         DISPLAY_PAGE[BPAGE]
         PAGENUM=BPAGE
      Else
         Boom
         MESSAGE["Word not","found!!","CLICK HERE"]
      End If
   End If
End Proc
Procedure _INSERT
   Bob 1,184,8,5
   While Mouse Key>0 : Wend
   Bob Off 1
   REQUEST["Insert a","card?","YES","NO"]
   If Param=1
      If Deek(Start(6))+1<100 and Deek(Start(6))>1
         BASE=Start(6)+(344*(PAGENUM-1))+2
         BASEEND=Start(6)+(344*(Deek(Start(6))))+2
         NEWBASE=Start(6)+(344*(PAGENUM))+2
         Copy BASE,BASEEND To NEWBASE
         Doke Start(6),Deek(Start(6))+1
         PAGE_FILL[PAGENUM]
         DISPLAY_PAGE[PAGENUM]
      End If
      If Deek(Start(6))+1=>100
         Boom
         MESSAGE["Too many","cards!","CLICK HERE"]
      End If
      If Deek(Start(6))=1
         Boom
         MESSAGE["Not enough","cards!","CLICK HERE"]
      End If
   End If
End Proc
Procedure _DELETE
   Bob 1,230,8,6
   While Mouse Key>0 : Wend
   Bob Off 1
   REQUEST["Do you wish","to delete?","YES","NO"]
   If Param=1
      REQUEST["Delete how","much?","ALL","CARD"]
      If Param=1
         INIT_FILE
         DISPLAY_PAGE[1]
      Else
         If Deek(Start(6))=1
            MESSAGE["Not enough","Cards!","CLICK HERE"]
         End If
         If Deek(Start(6))>1 and PAGENUM<Deek(Start(6))
            BASE=Start(6)+(344*(PAGENUM))+2
            BASEEND=Start(6)+(344*(Deek(Start(6))))+2
            NEWBASE=Start(6)+(344*(PAGENUM-1))+2
            Copy BASE,BASEEND To NEWBASE
            Doke Start(6),Deek(Start(6))-1
            DISPLAY_PAGE[PAGENUM]
         Else
            If Deek(Start(6))>1 and PAGENUM=Deek(Start(6))
               PAGE_FILL[PAGENUM]
               Dec PAGENUM
               Doke Start(6),Deek(Start(6))-1
               DISPLAY_PAGE[PAGENUM]
            End If
         End If
      End If
   End If
End Proc
Procedure PAGE_FILL[NUM]
   A$="    "
   BASE=Start(6)+(344*(NUM-1))+2
   Fill BASE To BASE+344,Leek(Varptr(A$))
End Proc
Procedure _DOWN
   If PAGENUM>1
      Dec PAGENUM
      DISPLAY_PAGE[PAGENUM]
   End If
End Proc
Procedure _UP
   If PAGENUM<99
      Inc PAGENUM
      If PAGENUM>Deek(Start(6))
         Doke Start(6),PAGENUM
      End If
      DISPLAY_PAGE[PAGENUM]
   End If
End Proc
Procedure CL0SE_SCRS
   While Screen<>-1
      Screen Close Screen
   Wend
End Proc
Procedure DEL_CHAR
   If TX=40
      If TY>80
         Add TY,-11
         TX=272
         Text TX,TY," "
         _POKEPAGE[32]
         D0_CUR
      Else
         If TY>67
            TY=67
            TX=144
            Text TX,TY," "
            _POKEPAGE[32]
            D0_CUR
         End If
      End If
   Else
      Add TX,-8
      Text TX,TY," "
      _POKEPAGE[32]
      D0_CUR
   End If
End Proc
Procedure _POKEPAGE[CHAR]
   BASE=Start(6)+(344*(PAGENUM-1))+2
   POS=(TX-40)/8
   If TY=80 Then Add POS,14
   If TY=91 Then Add POS,44
   If TY=102 Then Add POS,74
   If TY=113 Then Add POS,104
   If TY=124 Then Add POS,134
   If TY=135 Then Add POS,164
   If TY=146 Then Add POS,194
   If TY=157 Then Add POS,224
   If TY=168 Then Add POS,254
   If TY=179 Then Add POS,284
   If TY=190 Then Add POS,314
   Poke BASE+POS,CHAR
End Proc
Procedure PT_CHAR[K$]
   Text TX,TY,K$
   '
   _POKEPAGE[Asc(K$)]
   '
   '
   If TY=67
      If TX=144
         TX=40
         TY=80
      Else
         Add TX,8
      End If
   Else
      If TX<272
         Add TX,8
      Else
         If TX=272 and TY<190
            TX=40
            Add TY,11
         End If
      End If
   End If
   D0_CUR
   TEMP=Free
End Proc
Procedure WSET[T]
   Timer=0
   Clear Key
   Repeat
      TEMP1=Asc(Inkey$)
   Until Mouse Key<>0 or TEMP1<>0 or Timer=>T
End Proc
Procedure TITLE_SCR
   Unpack 13 To 0
   Screen Hide 0
   Palette $8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E
   Screen Show 0
   Fade 2,$8E,$444,$0,$BBB,$FFF,$FFF,$FFF,$FFF
   Wait 15
   WSET[5000]
   Fade 2,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E
   Wait 15
   Screen Close 0
End Proc
Procedure MAIN_SCR
   Unpack 14 To 0
   Screen Hide 0
   Palette $8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E,$8E
   Screen Show 0
   Fade 2,$8E,$444,$40D,$777,$27A,$8E,$AAA,$CCC,$BEF,$FFF,$3,$3D,$8D,$DD,$EEE,$0
   Wait 15
   Flash 12,"(533,4)(644,4)(844,4)(A44,4)(C44,4)(D44,4)(F44,4)(F77,4)(F99,8)(F77,4)(D44,4)(C44,4)(A44,4)(844,4)(644,4)(533,4)"
   Ink 15,9
   Reserve Zone 13
   For LOP=1 To 7
      Read X1,Y1
      Set Zone LOP,X1,Y1 To X1+43,Y1+28
   Next LOP
   Read X1,Y1,X2,Y2
   Set Zone 8,X1,Y1 To X2,Y2
   Read X1,Y1,X2,Y2
   Set Zone 9,X1,Y1 To X2,Y2
   Data 0,8
   Data 46,8
   Data 92,8
   Data 138,8
   Data 184,8
   Data 230,8
   Data 276,8
   Data 2,108,29,136
   Data 291,108,318,136
End Proc
Procedure HOUSE_KEEP
   For LOP=2 To 12
      Erase LOP
   Next LOP
   Erase 15 : Erase 16
   CL0SE_SCRS
   Colour Back $8E
   INIT_FILE
End Proc
Procedure INIT_FILE
   Erase 6
   Reserve As Work 6,34202
   A$="    "
   Fill Start(6)+2 To Start(6)+Length(6),Leek(Varptr(A$))
   ' number of pages
   Doke Start(6),1
   PAGENUM=1
   NUMPAGES=1
End Proc
Procedure DISPLAY_PAGE[NUM]
   NPAGES=Deek(Start(6))
   Bob Off
   Update
   Autoback 0
   Text 194,67,"   "
   Text 240,67,"   "
   Text 194,67,Str$(NUM)-" "
   Text 240,67,Str$(Deek(Start(6)))
   BASE=Start(6)+(344*(NUM-1))
   X=40
   For LOP=0 To 13
      Text X,60+7,Chr$(Peek(BASE+LOP+2))
      Add X,8
   Next LOP
   X=40
   For LOP=0 To 29
      Text X,80,Chr$(Peek(BASE+LOP+14+2))
      Text X,91,Chr$(Peek(BASE+LOP+44+2))
      Text X,102,Chr$(Peek(BASE+LOP+74+2))
      Text X,113,Chr$(Peek(BASE+LOP+104+2))
      Text X,124,Chr$(Peek(BASE+LOP+134+2))
      Text X,135,Chr$(Peek(BASE+LOP+164+2))
      Text X,146,Chr$(Peek(BASE+LOP+194+2))
      Text X,157,Chr$(Peek(BASE+LOP+224+2))
      Text X,168,Chr$(Peek(BASE+LOP+254+2))
      Text X,179,Chr$(Peek(BASE+LOP+284+2))
      Text X,190,Chr$(Peek(BASE+LOP+314+2))
      Add X,8
   Next LOP
   Autoback 2
   TX=40 : TY=67
   Bob 1,TX,TY,9
   POS=0
End Proc
Procedure D0_CUR
   Bob 1,TX,TY,9
End Proc
Procedure REQUEST[TXT1$,TXT2$,BUT1$,BUT2$]
   Bob Off 1
   Update
   Ink 15,14
   Get Cblock 1,100,78,130,64
   Paste Bob 100,78,7
   TXT1$=Left$(TXT1$,12)
   TXT2$=Left$(TXT2$,12)
   T1=Text Length(TXT1$)
   T2=Text Length(TXT2$)
   Text 111+((96-T1)/2),94,TXT1$
   Text 111+((96-T2)/2),105,TXT2$
   BUT1$=Upper$(Left$(BUT1$,4))
   BUT2$=Upper$(Left$(BUT2$,4))
   T1=Text Length(BUT1$)
   T2=Text Length(BUT2$)
   Text 116+((32-T1)/2),124,BUT1$
   Text 171+((32-T2)/2),124,BUT2$
   Set Zone 10,111,113 To 151,129
   Set Zone 11,166,113 To 206,129
   T$=""
   Clear Key
   Repeat
      A=Mouse Zone
      T$=Upper$(Inkey$)
   Until(A>9 and Mouse Key) or(T$=Left$(BUT1$,1)) or(T$=Left$(BUT2$,1))
   If T$=Left$(BUT1$,1) Then A=10
   If T$=Left$(BUT2$,1) Then A=11
   Add A,-9
   If A=1
      Bob 1,111,113,10
   Else
      Bob 1,166,113,10
   End If
   Bell
   Wait 2
   Play 0,0
   While Mouse Key>0 : Wend
   Bob Off
   Update
   Put Cblock 1,100,78
   Ink 15,9
   D0_CUR
End Proc[A]
Procedure REQUEST2[TXT1$,TXT2$]
   Bob Off 1
   Update
   Ink 15,14
   Get Cblock 1,100,78,130,64
   Paste Bob 100,78,8
   TXT1$=Left$(TXT1$,12)
   TXT2$=Left$(TXT2$,12)
   T1=Text Length(TXT1$)
   T2=Text Length(TXT2$)
   Text 111+((96-T1)/2),94,TXT1$
   Text 111+((96-T2)/2),105,TXT2$
   NEW_INPUT
   WORD$=Param$
   Put Cblock 1,100,78
   Ink 15,9
   D0_CUR
   Add A,-9
End Proc[WORD$]
Procedure NEW_INPUT
   I$=""
   Bob Off
   Ink 15,14
   X=115
   Text X,124,".........."
   Bob 1,X,124,9
   Clear Key
   Repeat
      K$=Inkey$
      KEYSCAN=Scancode
      If KEYSCAN=65 and Len(I$)>0
         I$=Left$(I$,Len(I$)-1)
         Add X,-8
         Text X,124,"."
         Bob 1,X,124,9
      End If
      If Instr(INP$,K$) and Len(I$)<10
         Text X,124,K$
         I$=I$+K$
         Add X,8
         Bob 1,X,124,9
      End If
   Until KEYSCAN=68
   Bob Off
   Update
End Proc[I$]
Procedure MESSAGE[TXT1$,TXT2$,BUT$]
   Bob Off 1
   Update
   Ink 15,14
   Get Cblock 1,100,78,130,64
   Paste Bob 100,78,8
   TXT1$=Left$(TXT1$,12)
   TXT2$=Left$(TXT2$,12)
   T1=Text Length(TXT1$)
   T2=Text Length(TXT2$)
   Text 111+((96-T1)/2),94,TXT1$
   Text 111+((96-T2)/2),105,TXT2$
   BUT$=Left$(BUT$,11)
   T1=Text Length(BUT$)
   Text 115+((88-T1)/2),124,BUT$
   Set Zone 10,111,113 To 206,129
   Clear Key
   Repeat
      A=Mouse Zone
   Until(A=10 and Mouse Key) or(Inkey$<>"")
   Bob 1,108,112,11
   Bell
   Wait 2
   Play 0,0
   While Mouse Key : Wend
   Bob Off
   Update
   Put Cblock 1,100,78
   Ink 15,9
   D0_CUR
End Proc
Procedure _SORT
   Bob 1,276,8,12
   While Mouse Key>0 : Wend
   Bob Off 1
   NPAGES=Deek(Start(6))
   If NPAGES>1
      REQUEST["Sort, are","you sure?","YES","NO"]
      If Param=1
         Reserve As Work 7,34202
         X$="    "
         Fill Start(7)+2 To Start(7)+Length(7),Leek(Varptr(X$))
         Dim A$(NPAGES-1)
         For LOP=0 To NPAGES-1
            BASE=Start(6)+(344*(LOP))+2
            A$(LOP)=""
            For LOP2=0 To 13
               A$(LOP)=A$(LOP)+Chr$(Peek(BASE+LOP2))
            Next LOP2
            '
            '
            A$(LOP)=A$(LOP)+(Str$(LOP)-" ")
         Next LOP
         Sort A$(0)
         Doke Start(7),Deek(Start(6))
         For LOP=0 To NPAGES-1
            NUM=Val(Mid$(A$(LOP),15,3))
            BASE=Start(6)+(344*(NUM))+2
            BASE2=Start(7)+(344*(LOP))+2
            Copy BASE,BASE+344 To BASE2
         Next LOP
         Bank Swap 6,7
         Erase 7
         PAGENUM=1
         MESSAGE["Cards are","now sorted.","CLICK HERE"]
         DISPLAY_PAGE[1]
      End If
   Else
      MESSAGE["Not enough","to sort!","CLICK HERE"]
   End If
End Proc