home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun: Productivity Pak 2 / rerun-productivity-pak-ii.d64 / dfcalc (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  18KB  |  575 lines
  1. 10 iffl=0thenfl=1:load"dp] dos5.1",8,1
  2. 11 iffl=1thenfl=2:sys52224:rem (c) by commodore
  3. 600 fore=0to24:poke54272+e,0:next:poke54296,15:goto3000
  4. 602 poke54277,58:poke54278,16:poke54273,35:poke54272,134
  5. 604 poke54276,33:fore=1to100:next:poke54276,16:return
  6. 3000 rem dfcalc 1.5a program for datafile by mike konshak (c)1986
  7. 3004 poke53281,0:poke53280,0:print"[158]":open4,4:open3,3:gosub4000
  8. 3006 rem----dim arrays
  9. 3008 b$=chr$(32):pi=3.14159265:cr$=chr$(13)
  10. 3010 fori=1to100:s$=s$+chr$(32):nexti
  11. 3012 dim f$(31),t%(31),l%(31),rec$(31),sum(17),buf(17)
  12. 3014 dim f(17),c$(17,15),pc(18),tt$(5),hc$(17):goto3044
  13. 3016 rem----get
  14. 3018 geta$:ifa$=""then3018
  15. 3020 return
  16. 3022 rem----prompt
  17. 3024 print"[153] press c[153][146]ont r[153][146]edo s[153][146]tart j[153][146]ump e[153][146]xit[158]"
  18. 3026 gosub3018:return
  19. 3028 rem----clear top 13 rows of screen
  20. 3030 forz=1to13:poke781,z:sys59903:nextz:return
  21. 3032 rem----disk error
  22. 3034 input#15,en,em$,et,es:if(en<20)or(en=62)thenet=0:return
  23. 3036 print" [150]disk error[146]"en"[157], "em$","et"[157],"es"[158]":et=8
  24. 3038 print" [153]press any key[153][146] to continue[158]"
  25. 3040 gosub3018:close5:close15:return
  26. 3042 rem----starting menu
  27. 3044 print"[158][147]   calculated reports program rev 1.5a "
  28. 3045 print" [158]  copyright (c)1986 by mike konshak   "
  29. 3046 print"[153]   use  o[153][146]ld predefined format"
  30. 3047 print"    or  n[153][146]ew format"
  31. 3048 print"        $[153][146] disk directory 4[153][146]"
  32. 3049 print"        q[153][146]uit program"
  33. 3050 print" transfer to:"
  34. 3051 print"        d[153][146] datafile dbms"
  35. 3052 print"        p[153][146] dfprint reports-lists-labels"
  36. 3054 print" [158]      press the appropriate key       [146]"
  37. 3056 gosub3018:ifa$="q"thenclose3:close4:print"[147]":end
  38. 3058 ifa$="n"thenk=1:goto3068
  39. 3059 ifa$="d"thenprint"[147][144]load"chr$(34)"datafile"chr$(34)",8":goto3064
  40. 3060 ifa$="o"thenk=2:fl=0:goto3068
  41. 3061 ifa$="p"thenprint"[147][144]load"chr$(34)"dfprint"chr$(34)",8":goto3064
  42. 3062 ifa$="$"ora$="4"thengosub3940:goto3044
  43. 3063 gosub602:goto3056
  44. 3064 print:print:print:print:print"run[158]"
  45. 3065 poke631,19:poke632,13:poke633,13:poke634,13:poke635,13:poke636,13
  46. 3066 poke198,6:new:end
  47. 3067 rem----open datafile, read file structure
  48. 3068 print"[153][147] available datafile record files are:[158]":@"$0:df]*"
  49. 3072 print"[153] name of datafile record file?[158]"
  50. 3074 print" ? "nf$:input"[145] ";a$:ifa$=""then3044
  51. 3076 ifa$=nf$then3096
  52. 3078 nf$=a$
  53. 3080 open15,8,15:open5,8,5,"0:df] "+nf$+",s,r":gosub3034:ifet=8then3044
  54. 3082 ifen=62thengosub3036:goto3044
  55. 3084 input#5,r,f,x:gosub3034:ifet=8then3044
  56. 3088 forn=1tof:input#5,f$(n),l%(n):nextn:gosub3034:ifet=8then3044
  57. 3090 close5:close15
  58. 3092 ifk=2then3386
  59. 3094 rem----define new format
  60. 3096 ck=1:print"[158][147]     define report header format    [146]"
  61. 3098 print"[153] enter width of report (136 max)"
  62. 3100 print"[158] ? 0[157][157]"pw:input"[145] ";pw:ifpw>136thenprint"[145][145][145][145][145][145][145]":goto3098
  63. 3102 print"[153] enter number of title lines in the"
  64. 3104 print" report header (4 lines max)"
  65. 3106 print"[158]  "nl:input"[145] ";nl:ifnl>4thenprint"[145][145][145][145][145][145][145]":goto3102
  66. 3108 ifnl=0thentt$(1)="[153]no titles":goto3118
  67. 3110 print:forj=1tonl:print"[153] title #[158]"j:print" ? >[157]"tt$(j)
  68. 3112 iflen(tt$(j))>37thenprint"[145]";
  69. 3114 input"[145] ";tt$(j):iftt$(j)=""thentt$(j)=">"
  70. 3116 nextj
  71. 3118 gosub3024:ifa$="e"then3044
  72. 3120 ifa$="j"then3386
  73. 3122 ifa$="r"ora$="s"then3096
  74. 3124 rem----print field info for reference
  75. 3126 print"[147]":fori=1to(22-int(f/2)):printchr$(17);:nexti
  76. 3128 print"[153] field name(length) data for [158]"nf$
  77. 3130 oe=1:if(f/2)=int(f/2)thenoe=0:goto3132
  78. 3132 of=int(f/2):fori=1toof+oe
  79. 3134 print" "i"[146][153]"f$(i)l%(i);
  80. 3136 ifoe=1then3140
  81. 3138 printtab(19)""i+of"[146][153]"f$(i+of)l%(i+of):goto3142
  82. 3140 ifi+of<fthenprinttab(19)""i+of+1"[146][153]"f$(i+of+1)l%(i+of+1)
  83. 3142 nexti
  84. 3144 rem----enter columnar data
  85. 3146 print"[158]     define report columnar format    [146]"
  86. 3148 gosub3030
  87. 3150 print"[153] calculate the total length of all"
  88. 3152 print" fields to be included in the report."
  89. 3154 print" allowing 2 spaces between each"
  90. 3156 print" column."
  91. 3158 print" enter the number of columns in report."
  92. 3160 print" (16 columns max)"
  93. 3162 print"[158] ? 0[157][157]"nc:input"[145] ";nc:ifnc>16then3148
  94. 3164 gosub3024:ifa$="e"then3044
  95. 3166 ifa$="j"then3386
  96. 3168 ifa$="r"then3148
  97. 3170 ifa$="s"then3096
  98. 3172 rem----column position
  99. 3174 fori=1tonc:gosub3030
  100. 3176 print"[153] enter position of column [158]"i""
  101. 3178 print" ? 0[157][157]"pc(i):input"[145] ";pc(i):ifpc(i)=0then3174
  102. 3180 ifpc(i)>pwthenprint"[145][145]":goto3178
  103. 3182 nexti
  104. 3184 gosub3024:ifa$="e"then3044
  105. 3186 ifa$="j"then3386
  106. 3188 ifa$="r"then3174
  107. 3190 ifa$="s"then3096
  108. 3192 fori=1tonc:gosub3030
  109. 3194 rem----column heading
  110. 3196 print"[153] enter heading of column [158]"i
  111. 3198 print"[153] heading is [158]";:ifi=ncthenprintpw-pc(i);:goto3202
  112. 3200 printpc(i+1)-2-pc(i);
  113. 3202 print"[146] [153]characters wide"
  114. 3204 print"[158] ? >[157]"hc$(i):input"[145] ";hc$(i):ifhc$(i)="r"then3192
  115. 3206 nexti
  116. 3208 gosub3024:ifa$="e"then3044
  117. 3210 ifa$="j"then3386
  118. 3212 ifa$="r"then3192
  119. 3214 ifa$="s"then3096
  120. 3216 rem----column contents data
  121. 3218 fori=1tonc:print" [158] format input routines for column"i
  122. 3220 gosub3030:print"[153] enter contents of column [158]"i
  123. 3222 print"[153] choose f[153][146]ield data in records"
  124. 3224 print"        e[153][146]quation"
  125. 3225 print"        r[153][146]unning total (balance)"
  126. 3226 print"        #[153][146] record number"
  127. 3228 print"[158] ? f[157]"left$(c$(i,1),1):input"[145] ";c$:c$(i,1)=c$+mid$(c$(i,1),2)
  128. 3230 ifc$="#"thenc$(i,1)="#":c$(i,13)="n":goto3344
  129. 3232 ifc$="f"then3238
  130. 3234 ifc$="e"then3260
  131. 3235 ifc$="r"then3239
  132. 3236 print"[145][145]":gosub602:goto3228
  133. 3238 print"[153] which field # will be in column [158]"i:goto3241
  134. 3239 print"[153] which column # is to have a running"
  135. 3240 print" total in column [158]"i"[146][157]? [153]enter 1[153][146] thru "i-1:goto3245
  136. 3241 print"[153] enter 1[153][146] thru "f
  137. 3242 print"[158] ? "mid$(c$(i,1),2,2):input"[145] ";c$
  138. 3243 if(val(c$)>f)or(val(c$)<=0)thenprint"[145][145]":goto3242
  139. 3244 goto3247
  140. 3245 print"[158] ? "mid$(c$(i,1),2,2):input"[145] ";c$
  141. 3246 if(val(c$)>i-1)or(val(c$)<=0)thenprint"[145][145]":goto3245
  142. 3247 c$(i,1)=left$(c$(i,1),1)+c$
  143. 3248 goto3328
  144. 3250 gosub3024:ifa$="e"then3044
  145. 3252 ifa$="j"then3386
  146. 3254 ifa$="r"then3220
  147. 3256 ifa$="s"then3096
  148. 3258 rem----column contents calculation
  149. 3260 eq=2:op=1:forj=0to3:rs$(j)="":nextj:goto3264
  150. 3262 eq=eq+4:op=op+1
  151. 3264 gosub3030:print"[153] enter equation [158]"op"[153][146]for column [158]"i
  152. 3266 ifop>1thengosub3308
  153. 3268 print" res[158][146]="rs$(op-1)
  154. 3270 print"[153] operand x[158]? .[157]"c$(i,eq)
  155. 3272 print"[153] operator [158]? .[157]"c$(i,eq+1)
  156. 3274 print"[153] operand y[158]? .[157]"c$(i,eq+2)
  157. 3276 print""tab(10):inputc$(i,eq)
  158. 3278 printtab(10):inputc$(i,eq+1)
  159. 3280 printtab(10):inputc$(i,eq+2)
  160. 3282 gosub3308:print" res="rs$(op)"[158]":c$(i,14)=rs$(op)
  161. 3284 gosub3024:ifa$="e"then3044
  162. 3286 ifa$="j"then3386
  163. 3288 ifa$="r"then3220
  164. 3290 ifa$="s"then3096
  165. 3292 ifeq=10then3328
  166. 3294 print"[145][153] expand equation? y[153][146] or n[158][146]             "
  167. 3296 print" ? n[157]"c$(i,eq+3):input"[145] ";c$(i,eq+3)
  168. 3298 ifc$(i,eq+3)="y"then3262
  169. 3300 :
  170. 3302 ifc$(i,eq+3)="n"thenforj=eq+4to12:c$(i,j)=".":nextj:goto3328
  171. 3304 print"[145][145]":goto3294
  172. 3306 rem----combine operations
  173. 3308 onopgoto3310,3312,3318
  174. 3310 rs$(1)=c$(i,2)+c$(i,3)+c$(i,4):goto3324
  175. 3312 ifc$(i,6)="res"then3316
  176. 3314 rs$(2)=c$(i,6)+c$(i,7)+"("+rs$(1)+")":goto3324
  177. 3316 rs$(2)="("+rs$(1)+")"+c$(i,7)+c$(i,8):goto3324
  178. 3318 ifc$(i,10)="res"then3322
  179. 3320 rs$(3)=c$(i,10)+c$(i,11)+"("+rs$(2)+")":goto3324
  180. 3322 rs$(3)="("+rs$(2)+")"+c$(i,11)+c$(i,12)
  181. 3324 return
  182. 3326 rem----field totals
  183. 3328 gosub3030:print"[153] set end-of-column operation"
  184. 3330 print" options: t[153][146]otal sum of column"
  185. 3332 print"          a[153][146]verage contents of column"
  186. 3334 print"          n[153][146]o operation to column"
  187. 3336 print"[158] ? n[157]"c$(i,13):input"[145] ";c$(i,13)
  188. 3338 if(c