home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1993 September / 1993-09.d64 / database (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  168 lines
  1. 0 rem copyright 1993 -compute publications intl ltd - all rights reserved
  2. 5 d=8:p=4:rem device and printer
  3. 10 w=60:h=20:rem number of entries and number of lines per entry
  4. 15 poke650,128:poke53265,0:poke53281,6:poke53280,6
  5. 20 ifpeek(49152)<>76thenload"data.ml",d,1
  6. 25 k=49152:dr=49155:in=49158:al=49161:ee=49164:cm=49167:bf=49170:lf=49173
  7. 30 j=h+1:dimar$(w+1,h+1),t$(12)
  8. 35 n$="":ar$(1,0)="":x=4:y=5:t=1
  9. 40 fora=1to12:readt$(a):next
  10. 45 poke198,0:n$="":print"[147][159]"chr$(14)tab(15)"[196]ata[194]ase"
  11. 50 printtab(4)"[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  12. 55 fora=1to6:printtab(4)"[159][221][154]"t$(a)tab(23)t$(a+6)tab(35)"[159][221]":next
  13. 60 printtab(4)"[159][173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]":poke53265,27:goto100
  14. 65 geta$:ifa$=""then65
  15. 70 ifa$=chr$(13)thenpoke781,12:poke782,0:poke783,0:sys65520:print"[154]";:goto110
  16. 75 printtab(y)"[154]"t$(t)
  17. 80 ifa$="[145]"andx>4thenx=x-1:t=t-1
  18. 85 ifa$=""andx<9thenx=x+1:t=t+1
  19. 90 ifa$="[157]"andy=23theny=5:t=t-6
  20. 95 ifa$=""andy=5theny=23:t=t+6
  21. 100 poke781,x:poke782,y:poke783,0:sys65520:printtab(y)""t$(t)"[145]":goto65
  22. 105 print"[147]";:end
  23. 110 ontgoto125,175,565,210,620,650,730,760,590,635,160,105
  24. 115 goto65
  25. 120 rem load file
  26. 125 nn$="":input"filename";nn$:ifnn$=""then45
  27. 130 syscm:open1,d,15:open8,d,8,nn$+",s,r":input#1,a,b$,b,c:ifa<>0then710
  28. 135 fora=1tow+1:sysin:ar$(a,0)=a$:iflen(a$)=0thenclose1:close8:goto45
  29. 140 forb=1toj:sysin:ar$(a,b)=a$:iflen(a$)=0andst=0thennexta:goto810
  30. 145 ifst=0thennextb:nexta:goto810
  31. 150 ar$(a+1,0)="":close1:close8:goto45
  32. 155 rem clear memory
  33. 160 print"are you sure? y/n":wait198,1:ifpeek(631)=89thenrun
  34. 165 goto45
  35. 170 rem recall
  36. 175 input"name";n$:ifn$=""then45
  37. 180 ifright$(n$,1)="*"thenn$=left$(n$,len(n$)-1)
  38. 185 fora=1tow:ifar$(a,0)=""thenn$="":goto800
  39. 190 ifleft$(ar$(a,0),len(n$))<>n$thennext:goto800
  40. 195 print"[147]"ar$(a,0);:forb=1toh:ifb<25thenprintchr$(13)ar$(a,b);:next
  41. 200 goto215
  42. 205 rem create entry
  43. 210 print"[147]";:fora=1tow:ifar$(a,0)<>""thennext:goto810:rem find end of file
  44. 215 print"";:b=0:sx=0
  45. 220 sysk:gosub485
  46. 225 onpeek(2)goto235,510,265,285,310,325,335,350,400,285,445,465,470,510
  47. 230 rem left
  48. 235 ifcx<>0then510
  49. 240 ifb=0then220
  50. 245 gosub485:syslf:ar$(a,b)=n$
  51. 250 ifb=sxthensx=sx-1:b=b-1:gosub495:printa$a$;:goto220
  52. 255 b=b-1:gosub500:printa$a$;:goto220
  53. 260 rem up
  54. 265 ifb=0then220
  55. 270 gosub485:syslf:ar$(a,b)=n$:ifb=sxthensx=sx-1:b=b-1:gosub495:printa$;:goto220
  56. 275 b=b-1:gosub500:printa$;:goto220
  57. 280 rem down, shifted return
  58. 285 ifb=hthen220
  59. 290 syslf:ar$(a,b)=n$:gosub500
  60. 295 ifcy=24thensx=sx+1:b=b+1:printchr$(13)ar$(a,b);:gosub500:goto220
  61. 300 b=b+1:gosub500:printa$;:goto220
  62. 305 rem clr/home (go to bottom)
  63. 310 syslf:ar$(a,b)=n$:forb=0toj:ifar$(a,b+1)<>""thennext
  64. 315 sx=b:gosub495:print"";:goto220
  65. 320 rem home
  66. 325 syslf:ar$(a,b)=n$:b=0:sx=b:gosub495:printa$;:goto220
  67. 330 rem insert
  68. 335 gosub485:syslf:ar$(a,b)=n$:gosub500:iflen(ar$(a,b))=39then220
  69. 340 goto515
  70. 345 rem delete
  71. 350 fl=1:ifcx<>0then510
  72. 355 ifb=0then220
  73. 360 ifb=sxthensx=sx-1:print"";:gosub485:gosub495
  74. 365 syslf:ar$(a,b)=n$:iflen(ar$(a,b-1))=39thenar$(a,b-1)=left$(ar$(a,b-1),38)
  75. 370 a$=left$(ar$(a,b),39-len(ar$(a,b-1)))
  76. 375 ar$(a,b)=right$(ar$(a,b),len(ar$(a,b))-len(a$))
  77. 380 ifar$(a,b)=""thenforu=btoh:ar$(a,u)=ar$(a,u+1):next
  78. 385 b=b-1:cy=cy-1:gosub500:printar$(a,b);:gosub485:printa$;:syslf:ar$(a,b)=n$
  79. 390 gosub495:goto220
  80. 395 rem return
  81. 400 ifb=hthen220
  82. 405 fl=1:ifar$(a,h)<>""then290
  83. 410 ifcy=24thensx=sx+1
  84. 415 gosub485:syslf:ar$(a,b)=n$
  85. 420 foru=htob+1step-1:ar$(a,u)=ar$(a,u-1):next:rem insert
  86. 425 b=b+1:gosub500:sysbf:ar$(a,b)=n$
  87. 430 ar$(a,b-1)=left$(ar$(a,b-1),len(ar$(a,b-1))-len(ar$(a,b)))
  88. 435 print:gosub485:gosub495:goto220
  89. 440 rem f1
  90. 445 ifa=1then220
  91. 450 iffl=0then545
  92. 455 fl=0:syslf:ar$(a,b)=n$:goto530
  93. 460 rem f3 and f7
  94. 465 ifar$(a+1,0)=""then220
  95. 470 iffl=0then545
  96. 475 fl=0:syslf:ar$(a,b)=n$:goto530
  97. 480 rem save cursor location
  98. 485 poke783,1:sys65520:cx=peek(782):cy=peek(781):return
  99. 490 rem redraw screen
  100. 495 poke212,0:print"[147]"ar$(a,sx);
  101. 496 foru=sx+1tosx+24:ifu<>jthenprintchr$(13)ar$(a,u);:next
  102. 500 poke783,0:poke782,cx:poke781,cy:sys65520:return
  103. 505 rem print to screen
  104. 510 fl=1:ifcx=38andb=hthenprinta$"[157]";:goto220
  105. 515 printa$;:gosub485:ifcx=39thensyslf:ar$(a,b)=n$:print:b=b+1
  106. 520 goto220
  107. 525 rem alphabetize it
  108. 530 b=0:foru=0toh:ifar$(a,u)=""thennext:goto540
  109. 535 n$=ar$(a,u):ar$(a,u)="":ar$(a,b)=n$:b=b+1:next
  110. 540 sysal
  111. 545 ifa$="[133]"anda<>1thena=a-1:goto195
  112. 550 ifa$="[134]"andar$(a+1,0)<>""thena=a+1:goto195
  113. 555 goto45
  114. 560 rem list entries
  115. 565 fora=1tow:ifar$(a,0)=""then815
  116. 570 print:forb=0toh:ifar$(a,b)<>""thenprintar$(a,b):nextb
  117. 575 ifpeek(203)<>64then575
  118. 580 nexta:goto810
  119. 585 rem erase entry
  120. 590 input"name";n$:ifn$=""then45
  121. 595 ifright$(n$,1)="*"thenn$=left$(n$,len(n$)-1)
  122. 600 fora=1tow+1:ifar$(a,0)=""thenn$="":goto800
  123. 605 ifleft$(ar$(a,0),len(n$))<>n$thennext:goto800
  124. 610 ar$(a,0)="":sysee:goto45
  125. 615 rem directory
  126. 620 poke186,d:sysdr:print:goto815
  127. 625 ifb=0then810
  128. 630 rem scratch file
  129. 635 input"filename";n$:ifn$=""then45
  130. 640 open1,d,15,"s0:"+n$:close1:goto45
  131. 645 rem save file
  132. 650 close1:close8:nn$="":poke198,0:rem no replace
  133. 655 ifright$(nn$,1)="*"thennn$=""
  134. 660 ifnn$=""theninput"filename";nn$:ifnn$=""then45
  135. 665 open1,d,15:open8,d,8,""+nn$+",s,w":input#1,a,b$,b,c
  136. 670 ifa=63thenclose8:print"replace "nn$"? y/n":wait198,1:ifpeek(631)<>89then650
  137. 675 ifa=63thenopen8,d,8,"@0:"+nn$+",s,w":input#1,a,b$,b,c
  138. 680 ifa<>0then710
  139. 685 fora=1tow+1:print#8,ar$(a,0):ifar$(a,0)=""thenclose1:close8:goto45
  140. 690 forb=1toj:print#8,ar$(a,b):ifar$(a,b)<>""thennextb
  141. 695 nexta
  142. 700 close1:close8:goto45
  143. 705 rem drive status
  144. 710 printa;b$;b;c:close1:close8:goto815
  145. 715 rem quit
  146. 720 print"[147]";:end
  147. 725 rem print file
  148. 730 print"press return to cancel"
  149. 735 open1,p,7:fora=1tow:ifar$(a,0)=""then750
  150. 740 print#1:forb=0toh:ifar$(a,b)<>""thenprint#1,ar$(a,b):nextb
  151. 745 geta$:ifa$<>chr$(13)thennexta
  152. 750 close1:goto815
  153. 755 rem print entry
  154. 760 input"name";n$:ifn$=""then45
  155. 765 ifright$(n$,1)="*"thenn$=left$(n$,len(n$)-1)
  156. 770 fora=1tow:ifar$(a,0)=""thenn$="":goto800
  157. 775 ifleft$(ar$(a,0),len(n$))<>n$thennexta:goto800
  158. 780 print"press return to cancel"
  159. 785 open1,p,7:print#1:forb=0toh:ifar$(a,b)<>""thenprint#1,ar$(a,b)
  160. 790 geta$:ifa$<>chr$(13)thennext
  161. 795 close1:goto815
  162. 800 print"not found, ":goto815
  163. 805 close1:close8:print"file not compatible, ":ar$(1,0)="":nn$="":goto815
  164. 810 print"full file, ";
  165. 815 poke198,0:print"press any key":wait198,1:goto45
  166. 820 data load file,recall entry,list file,create entry,directory,save file
  167. 825 data print file,print entry,erase entry,scratch file,clear memory,quit
  168.