home *** CD-ROM | disk | FTP | other *** search
/ Colossal Cookbook / ColossalCookbook.cdr / diet / nutmg / sortnut.bas (.txt) < prev   
Encoding:
GW-BASIC  |  1986-03-07  |  3.5 KB  |  51 lines
  1. 10  '     SORTNUT                  3-7-86                 Robert F. Savryk                -------                  ------                 ----------------          '
  2. 100  MAX%=997:DIM FD$(MAX%),PNTR%(MAX%):OPEN "FOODFILE" AS #1 LEN=121:FIELD #1, 121 AS F$
  3. 110  NUTRIENT$="NO":CLS:WIDTH 40:KEY OFF:LOCATE 1,18:COLOR 15,0:PRINT "SORT";:COLOR 7,0:LOCATE 5,3:PRINT "1 - FOOD GROUP":LOCATE 6,3:PRINT "2 - FOODFILE"
  4. 120  LOCATE 8,1:PRINT "Choose a number ";:C$="":WHILE C$="":C$=INKEY$:WEND:ON VAL(C$) GOTO 130,5505
  5. 121  GOTO 120
  6. 130  CLS:LOCATE 1,12:COLOR 15,0:PRINT "SORT FOOD GROUPS";:COLOR 7,0:LOCATE 5,1:INPUT "ENTER FOOD GROUP CODE (1-2 letters) ",KY$
  7. 135  IF LEN(KY$)>2 THEN LOCATE 7,1:PRINT "Enter a maximum of 2 letters - try again":LOCATE 5,37:INPUT "",KY$
  8. 140   H$="FOOD GROUP":GOTO 5455
  9. 5450  DIM FD$(MAX%),PNTR%(MAX%):COMMON F$,MAX%,MNR%,ANR%,DRV$:IF PRINTNUT$="YES" THEN 5455 ELSE DSPLYNUT$="YES"
  10. 5455  CLS:WIDTH 40:S$="G":LOCATE 3,3,0:PRINT "Please Wait ... Sorting Food Group";
  11. 5460  KEYS%=0:IF LEN(KY$)=2 THEN CT%=2 ELSE CT%=1
  12. 5465  FOR RF%=2 TO MAX%:GET #1, RF%
  13. 5470  IF MID$(F$,21,CT%)=KY$ THEN KEYS%=KEYS%+1:FD$(KEYS%)=LEFT$(F$,20):PNTR%(KEYS%)=RF%
  14. 5475  NEXT:GOTO 5540
  15. 5500  DIM FD$(MAX%),PNTR%(MAX%):COMMON F$,MAX%,MNR%,ANR%,DRV$:IF PRINTNUT$="YES" THEN 5505 ELSE DSPLYNUT$="YES"
  16. 5505  WIDTH 80:S$="F":LOCATE 12,24,0:PRINT "Please Wait ... Sorting Foodfile ..."
  17. 5510  KEYS%=0:FOR RF%=2 TO MAX%:GET #1, RF%
  18. 5515  IF LEFT$(F$,1)<>" " THEN KEYS%=KEYS%+1:FD$(KEYS%)=LEFT$(F$,20):PNTR%(KEYS%)=RF%
  19. 5520  NEXT
  20. 5540  D%=4
  21. 5545  IF D%<KEYS% THEN D%=D%+D%:GOTO 5545
  22. 5550  D%=D%-1
  23. 5555  D%=INT(D%/2):IF D%=63 THEN PRINT "1/4 DONE ..." ELSE IF D%=15 THEN PRINT "1/2 DONE ..." ELSE IF D%=3 THEN PRINT "3/4 DONE ..." ELSE  IF D%=1 THEN PRINT "ALMOST DONE ... "
  24. 5557  IF D%<1 THEN IF S$="G" AND PRINTNUT$="YES" THEN CHAIN "PRINTNUT",6455,ALL ELSE IF D%<1 THEN IF S$="G" GOTO 5660
  25. 5558  IF D%<1 THEN IF S$="F" AND PRINTNUT$="YES" THEN CHAIN "PRINTNUT",6505,ALL ELSE IF D%<1 THEN IF S$="F" GOTO 5600
  26. 5560  FOR J%=1 TO KEYS%-D%:FOR I%=J% TO 1 STEP -D%:IF FD$(I%+D%) > FD$(I%) THEN GOTO 5580
  27. 5565  TMP$=FD$(I%):TMP%=PNTR%(I%):FD$(I%)=FD$(I%+D%)
  28. 5570  PNTR%(I%)=PNTR%(I%+D%):FD$(I%+D%)=TMP$:PNTR%(I%+D%)=TMP%
  29. 5575  NEXT
  30. 5580  NEXT J%:GOTO 5555
  31. 5600  CLS:LOCATE 1,30:COLOR 15,0:PRINT "DISPLAY FOODFILE";:COLOR 7,0:LOCATE 2,1:FOR I%=1 TO 3:PRINT " NO. FOOD DESCRIPTION     ";:NEXT:PRINT STRING$(78,"-")
  32. 5605  TOP%=4:BOT%=23:DEF SEG:POKE &H5B,TOP%:POKE &H5C,BOT%:LOCATE 12,24:PRINT SPACE$(36):LOCATE 4,2:Y%=CSRLIN:X%=POS(0):C%=0
  33. 5610  FOR I%=1 TO KEYS% STEP 20:Y%=4:C%=C%+1:FOR J%=0 TO 19:LOCATE Y%,X%:PRINT USING "###";PNTR%(I%+J%);:PRINT " ";FD$(I%+J%);"  ";:Y%=Y%+1:IF I%+J%=KEYS% THEN GOTO 5635 ELSE NEXT
  34. 5615  IF C%=1 THEN X%=28:GOTO 5630 ELSE IF C%=2 THEN X%=54:GOTO 5630 ELSE IF C%=3 THEN X%=2:C%=0
  35. 5620  LOCATE 25,27,1:PRINT "Continue sorting (Y or N) ?";:C$="":WHILE C$="":C$=INKEY$:WEND:IF C$="N" THEN 5650
  36. 5630  NEXT I%
  37. 5635  IF C%=1 THEN RT%=28 ELSE IF C%=2 THEN RT%=54 ELSE RT%=79
  38. 5640  FOR Y%=Y% TO 23:LOCATE Y%,X%:PRINT SPACE$(RT%-X%);:NEXT:IF C%=3 THEN GOTO 5650 ELSE IF C%=2 THEN X%=54 ELSE IF C%=1 THEN X%=28
  39. 5645  FOR Y%=4 TO 23:LOCATE Y%,X%:PRINT SPACE$(79-X%);:NEXT
  40. 5650  TOP%=1:BOT%=25:DEF SEG:POKE &H5B,TOP%:POKE &H5C,BOT%
  41. 5655  LOCATE 25,27:PRINT SPACE$(27);:LOCATE 24,34:PRINT "END OF SORT";:IF NUTRIENT$="NO" THEN END
  42. 5657  ERASE FD$,PNTR%:LOCATE 25,23:PRINT "Continue DISPLAY Routines (Y or N) ? ";:C$="":WHILE C$="":C$=INKEY$:WEND:CLS:LOCATE 25,33:PRINT "Please Wait ...";:IF C$="Y" THEN CHAIN "DSPLYNUT",5010,ALL ELSE CHAIN "NUTRIENT",940,ALL
  43. 5660  CLS:LOCATE 1,20-LEN(H$)/2:COLOR 15,0:PRINT H$;:COLOR 7,0:LOCATE 3,1:PRINT "GROUP   FOOD DESCRIPTION     FOOD NO.":PRINT STRING$(38,"-"):Y%=CSRLIN
  44. 5665  FOR I%=1 TO KEYS%:LOCATE Y%,3:PRINT KY$;:LOCATE CSRLIN,9:PRINT FD$(I%);:LOCATE CSRLIN,31:PRINT PNTR%(I%):Y%=Y%+1:IF Y%=24 THEN 5668 ELSE IF I%=KEYS% THEN 5675
  45. 5667  NEXT I%
  46. 5668  IF I%=KEYS% THEN 5675
  47. 5670  LOCATE 25,9,1:PRINT "Display more (Y or N) ?";:C$="":WHILE C$="":C$=INKEY$:WEND:IF C$="Y" THEN FOR Y%=5 TO 23:LOCATE Y%,1:PRINT SPACE$(79);:NEXT:Y%=5:GOTO 5667
  48. 5675  LOCATE 25,9:PRINT SPACE$(25);:LOCATE 24,14:PRINT "END OF GROUP";:IF NUTRIENT$="NO" THEN CLS:END
  49. 5680  ERASE FD$,PNTR%:LOCATE 25,3:COLOR 0,7:PRINT "Continue DISPLAY Routines (Y or N) ?";:COLOR 7,0:C$="":WHILE C$="":C$=INKEY$:WEND:IF C$="Y" AND DSPLYNUT$="YES" THEN CLS:LOCATE 3,13:PRINT "Please Wait ... ";:CHAIN "DSPLYNUT",5010,ALL ELSE
  50. 5685  IF C$="N" AND DSPLYNUT$="YES" THEN CLS:LOCATE 3,13:PRINT "Please Wait ... ";:CHAIN "NUTRIENT",940,ALL ELSE IF C$="Y" AND NUTRIENT$="NO" THEN GOTO 110 ELSE CLS:END
  51.