home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1985 December / 1985-12.d64 / dmanager (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  4KB  |  85 lines
  1. 10 poke55,0:poke56,25:clr:sa=peek(56)*256:print"[147]"
  2. 20 ln=5:d$="":s$="        "
  3. 30 print chr$(142)tab(8)d$" dictionary manager "
  4. 40 print " press: [1] to review entries":print s$"[2] to add entries"
  5. 50 print s$"[3] to edit entries":print s$"[4] to print entries"
  6. 60 print s$"[5] to prepare a new disk":print s$"[6] to exit the manager"d$
  7. 70 get k$:if k$<"1" or k$>"6" then 70
  8. 80 on val(k$) gosub 400,500,700,600,100,90:goto 30
  9. 90 print"[147]":end
  10. 100 print s$" create new dictionary disk ":print"are you sure";
  11. 110 input" [y/n]";k$:if left$(k$,1)<>"y" then print"[147]":return
  12. 120 input"unique id for this disk";id$:print"formatting....please wait"
  13. 130 open 15,8,15,"n0:dictionary disk,"+id$:gosub1000:if er then return
  14. 140 print"formatting complete...creating headings:"
  15. 150 for i=65 to 90:open 1,8,8,"0:"+chr$(i)+",s,w":gosub 1000:if er then 180
  16. 160 close 1:print chr$(i);:next:print
  17. 170 print"** dictionary disk created **":goto 910
  18. 180 print"creating file for ";chr$(i):print"try again";:goto 110
  19. 200 print s$"(enter @[146] for menu)"
  20. 210 input"starting with";l$:l=asc(l$+chr$(0)):if l=64 or l=42 then return
  21. 220 l$=chr$(l):if l<65 or l>90 then print s$l$" is not a valid letter":goto 210
  22. 230 open15,8,15:open1,8,8,"0:"+l$+k$:gosub 1000:if er=0 then return
  23. 240 print"trying to access file for ";l$:goto 210
  24. 300 f=0:get#1,k$:k=asc(k$+chr$(0)):if k>127 then k=k and 127:f=1
  25. 310 if k<>39 then k=k or 64
  26. 320 w$=w$+chr$(k):if st or f then return
  27. 330 goto 300
  28. 400 print s$" review entries ":k$=",s,r":gosub 200:if l=64 or l=42 then return
  29. 410 get#1,k$:w$=l$:gosub 300:if mid$(w$,2,1)<>"@" then 430
  30. 420 print"** no entries for ";l$;" **":goto 910
  31. 430 print chr$(14)"[147][197]ntries for "l$:print"([200]old down  space [146] to advance)"
  32. 440 print s$;w$:if st then 460
  33. 450 wait 203,64,64:w$=l$:gosub 300:goto 440
  34. 460 if st<>64 then 1000
  35. 470 wait 203,64:poke 198,0:goto 910
  36. 500 print s$" add entries ":k$=",a":gosub 200:if l=64 or l=42 then return
  37. 510 print chr$(14)"[147][197]nter words starting with ";l$:print"([212]ype @[146] to quit)"
  38. 520 w$="":input w$:f$=left$(w$,1):if f$="@"then close1:close15:print"[147]":return
  39. 530 if f$<>l$ and f$<>chr$(l+128)thenprintw$" doesn't start with "l$"":goto520
  40. 540 n=len(w$):if n<ln then print w$" has fewer than"ln"letters":goto 520
  41. 550 for i=2 to n:k=asc(mid$(w$,i)):if k=39 then 570
  42. 560 if k<65 or(k>90 and k<193)or k>218 then k=0
  43. 570 k=k and 63:if i=n then k=k or 128
  44. 580 if k then print#1,chr$(k);:if st then 1000
  45. 590 next:print s$w$" added.":goto 520
  46. 600 print s$"  print entries  ":print"  (enter *[146] to print all entries)"
  47. 610 k$=",s,r":gosub 200:if l=64 then return
  48. 620 open 4,4,7:if l=42 then for i=65 to 90:l$=chr$(i):k$=",s,r":gosub 230
  49. 630 get#1,k$:w$=l$:gosub 300:k=st:if mid$(w$,2,1)<>"@" then 640
  50. 635 print#4,"** no entries for "l$" **":goto 680
  51. 640 print#4,chr$(14)"[197]ntries beginning with "l$":":print#4
  52. 650 forj=1to4:print#4,w$;:ifj<4thenprint#4,right$("                    ",20-len(w$))";
  53. 655 [139] k [167] j[178]4:[137] 670
  54. 660 w$[178]l$:[141] 300:k[178]st
  55. 670 [130] j:[152]4:[139] k[178]0 [167] 650
  56. 675 [139] k[179][177]64 [167] [160] 4:[137] 1000
  57. 680 [160] 1:[160] 15:[152]4:[152]4:[139] l[178]42 [167] [130] i
  58. 690 [160] 4:[142]
  59. 700 [153] s$" edit entries ":k$[178]",s,r":[141] 200:[139] l[178]64 [176] l[178]42 [167] [142]
  60. 710 [153] [199](14)"loadvaldit words starting with "l$":"
  61. 720 [153]"(valnter @wait to cancel editing)":[161]#1,k$:ad[178]sa
  62. 730 w$[178]l$:[141] 300:[139] [202](w$,2,1)[178]"@" [167] [153]"** (NULL)o entries **":[137] 910
  63. 740 [153]"  "w$:k$[178]"":[133]"on";k$:n[178][195](k$):[139] n[178]0 [167] 830
  64. 750 f$[178][200](k$,1):[139] f$[178]"@" [167] [153]"valditing canceled":[137] 910
  65. 760 [139] f$[179][177]l$ [175] f$[179][177][199](l[170]128)[167] [153] k$" doesn't start with "l$:[137] 740
  66. 770 [139] n[179]ln [167] [153] k$"has fewer than"ln"letters":[137] 740
  67. 780 [129] i[178]2 [164] n:k[178][198]([202](k$,i)):[139] k[178]39 [167] 810
  68. 790 [139](k[177]64 [175] k[179]91)[176](k[177]192 [175] k[179]219) [167] 810
  69. 800 [153] k$" has invalid character":ad[178]ad[171]i[171]2:[137] 740
  70. 810 k[178]k [175] 63:[139] i[178]n [167] k[178]k [176] 128
  71. 820 [151] ad,k:ad[178]ad[170]1:[130]:[139] ad[177]40959 [167] ad[178]ad[171]n:[153]"buffer full":[137]850
  72. 830 [139] st[178]0 [167] 730
  73. 840 [139] st[179][177]64 [167] 1000
  74. 850 [153]"** (NULL)riting new file for "l$" **"
  75. 860 [160] 1:[152]15,"s0:"[170]l$:[141] 1000:[139] er[179]2 [167] 890
  76. 870 [133]"try again [y/n]";k$:[139] [200](k$,1)[179][177]"y" [167] [142]
  77. 880 [159] 15,8,15:[137] 850
  78. 890 [159] 1,8,8,"0:"[170]l$[170]",s,w":[152]1:[139] st [167] [141] 1000:[137] 870
  79. 900 [129] i[178]sa [164] ad[171]1:[152]1,[199]([194](i));:[130]:[139] st [167] [141] 1000:[137] 870
  80. 910 [160] 1:[160] 15:[153]" press any key for menu "
  81. 920 [161] k$:[139] k$[178]"" [167] 920
  82. 930 [153]"load":[142]
  83. 1000 [132]15,er,e$:[139] er[177]1 [167] [153]" disk error:";er;e$:[160] 15:[160] 1
  84. 1010 [142]
  85.