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