1. GOTO Spaghetti code

Spaghetti code:

This is QBasic conversion of a GW-Basic program that
I wrote many years ago.  The source had previously never been
shared.

Pardon the 7-bit copies of some of the 8-bit characters I used.
Again, Code resulting from a young self teaching Lucius Hilley.

A binary copy made available if anyone cares.

'-------------------------------
'  ** PHONE.BAS **
DECLARE SUB Choice (Ch, Sze)
DECLARE SUB Delay (Sec)
DECLARE SUB LoadDir (Set)
DECLARE SUB NewEntry ()
DECLARE SUB Pather ()
DECLARE SUB PrintDir (Set)
DECLARE SUB QNQ (Srchd$)
DECLARE SUB Search (Set)
DECLARE SUB Sorter ()
DECLARE SUB ViewDir (Set)
DECLARE FUNCTION Poss (Ch)

2
  Sze = 8
  DIM SHARED N$(1 TO 256), CA$(1 TO 256), BA$(1 TO 256), PH$(1 TO 256)
  DIM SHARED NN$(1 TO 256), NCA$(1 TO 256), NB$(1 TO 256), NPH$(1 TO 256)
  DIM SHARED K$(1 TO 40), See$(1 TO Sze), A(10), Col, Fle$, Fle, Lin, Dirt$
  DATA "      SEARCH Data      ","       READ Data       "
  DATA "       EDIT Data       ","       SORT Data       "
  DATA "      PRINT  Data      ","    ADD to Directory   "
  DATA "  CHANGE  Directories  ","     E   X   I   T     "
  DATA "Û° Ceace's Personal Directory by œucius °"
  'DATA "Û° œucius' Personal PHONE Directory °"
  'DATA "Û° Larry & Connie's Personal Directory by œucius °"
  DATA 13,0,0      ' Backgrnd Colors
  DATA 14,1        ' Borderline Colors
  DATA 15,5        ' Normal Menu Colors
  DATA 15,4        ' Highlight Bar Colors
  Dirt$ = "PHONE.DIR"
  Pather
  Det = 1
  PLAY "L64CL64DL64EL64FL64GL64AL64B"
4
  RESTORE
  FOR A = 1 TO Sze
    READ See$(A)
  NEXT
  READ Bc$
  FOR A = 0 TO 8
    READ V$
    A(A) = VAL(V$)
  NEXT
  CLOSE
  COLOR A(0), A(1), A(2)
  CLS
  DO
    Bd$ = Bd$ + Bc$
  LOOP UNTIL LEN(Bd$) > 104
  FOR A = 1 TO 25
    B = 26 - A
    LOCATE A, 1
    PRINT MID$(Bd$, B, 80);
  NEXT
  Lin = 4
  Col = 28
  COLOR A(3), A(4)
  LOCATE Lin, Col
  PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
  FOR A = 1 TO Sze * 2 + 1
    LOCATE , Col
    PRINT "º";
    LOCATE , Col + 24
    PRINT "º"
  NEXT
  LOCATE , Col
  PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
  COLOR A(5), A(6)
  LOCATE Lin + 1, Col + 1
  PRINT SPACE$(23)
  FOR A = 1 TO Sze
    LOCATE , Col + 1
    PRINT See$(A)
    LOCATE , Col + 1
    PRINT SPACE$(23)
  NEXT
  Choice Det, Sze
  SELECT CASE Det
    CASE 1
      LoadDir Set
      Search Set
      GOTO 4
    CASE 2
      CLS
      LoadDir Set
      ViewDir Set
      LOCATE 25, 8
      PRINT "Press any key to return to Menu ......";
      DO
        Retu$ = INKEY$
      LOOP WHILE Retu$ = ""
      GOTO 4
    CASE 3
      LoadDir Set
      GOTO 40
    CASE 4
      LoadDir Set
      DIM SHARED B(1 TO 256), A$(1 TO 256), C$(1 TO 256), D$(1 TO 256)
      DIM SHARED BI$(1 TO 256)
      Sorter
      GOTO 4
    CASE 5
      CLS
      LOCATE 13, 25
      PRINT "Please wait while printing...";
      LoadDir Set
      PrintDir Set
      GOTO 4
    CASE 6
      OPEN Dirt$ FOR APPEND AS 1
      NewEntry
      GOTO 4
    CASE 7
      CLS
      LOCATE 5, 25
      PRINT "Present Directory File-Name is "; Dirt$;
      LOCATE 8, 20
      PRINT "Enter New Directory File-Name ¯ ";
      INPUT "", N$
      IF N$ > "" THEN
        Dirt$ = N$
        Pather
      END IF
      GOTO 4
    CASE 8
      COLOR 7, 0
      CLS
      CLOSE
      PLAY "L64BL64AL64GL64FL64EL64DL64C"
      END
  END SELECT
40
  CLS
  LOCATE 2
  COLOR 31
  IF CHK5$ <> "123" THEN
    PRINT TAB(12); "Are you SURE you want to Edit (Y/N)?"
    DO
      CHK$ = UCASE$(INKEY$)
    LOOP UNTIL CHK$ = "Y" OR CHK$ = "N"
    IF CHK$ = "N" THEN
      GOTO 4
    END IF
  END IF
42
  COLOR 15
  LOCATE 25, 11
  INPUT "INPUT NUMBER TO LOOK AT: ", et
  IF et > Set OR et < 1 THEN
    LOCATE 25, 36
    PRINT "             ";
    GOTO 42
  END IF
  CLS
  PRINT CHR$(13); N$(et), , BA$(et), PH$(et); CHR$(13)
  PRINT TAB(11); "Is THIS what you want to Edit (Y/N)?"
  DO
    CHK1$ = UCASE$(INKEY$)
  LOOP UNTIL CHK1$ = "Y" OR CHK1$ = "N"
  IF CHK1$ = "N" THEN
    GOTO 40
  END IF
47
  CLS
  LOCATE 2
  PRINT CHR$(13); TAB(11); "N === Name"
  PRINT CHR$(13); TAB(11); "B === Birthday"
  PRINT CHR$(13); TAB(11); "P === Phone number"
  PRINT CHR$(13); TAB(11); "D === DELETE entry"
  PRINT TAB(8); STRING$(24, 95)
  PRINT CHR$(13); TAB(11); "A === ANOTHER"
  PRINT CHR$(13); TAB(11); "E === END"; STRING$(2, 13)
  PRINT TAB(7); "TYPE LETTER OF CHOICE";
  DO
    KDM = 0
    DO
      CHO$ = UCASE$(INKEY$)
    LOOP WHILE CHO$ = ""
    SELECT CASE CHO$
      CASE "N"
        KDM = 0
      CASE "B"
        GOTO 62
      CASE "P"
        GOTO 68
      CASE "D"
        GOTO Delete
      CASE "A"
        CHK5$ = "123"
        GOTO 40
      CASE "E"
        GOTO 74
      CASE ELSE
        KDM = 1
    END SELECT
  LOOP WHILE KDM
56
  CLS
  PRINT CHR$(13); N$(et), , BA$(et), PH$(et); STRING$(2, 13)
  PRINT "OLD NAME IS: " + N$(et); STRING$(3, 13)
  INPUT "NEW NAME: ", NN$(et)
  CLS
  PRINT CHR$(13); NN$(et), "Is THIS the NAME you want (Y/N)?"
  DO
    CHK2$ = UCASE$(INKEY$)
  LOOP UNTIL CHK2$ = "Y" OR CHK2$ = "N"
  IF CHK2$ = "N" THEN
    GOTO 47
  END IF
  N$(et) = NN$(et)
  LOCATE 25, 25
  PRINT "SAVED";
  Delay 2
  GOTO 47
62
  CLS
  PRINT CHR$(13); N$(et), , BA$(et), PH$(et); STRING$(2, 13)
  PRINT "OLD BIRTHDAY IS: " + BA$(et); STRING$(2, 13)
  INPUT "NEW BIRTHDAY: ", NB$(et)
  CLS
  PRINT CHR$(13); NB$(et), "Is THIS the BIRTHDAY you want (Y/N)?"
  DO
    CHK3$ = UCASE$(INKEY$)
  LOOP UNTIL CHK3$ = "Y" OR CHK3$ = "N"
  IF CHK3$ = "N" THEN
    GOTO 47
  END IF
  BA$(et) = NB$(et)
  LOCATE 25, 25
  PRINT "SAVED";
  Delay 2
  GOTO 47
68
  CLS
  PRINT CHR$(13); N$(et), , BA$(et), PH$(et); STRING$(2, 13)
  PRINT "OLD PHONE NUMBER IS: " + PH$(et); STRING$(3, 13)
  INPUT "NEW PHONE NUMBER: ", NPH$(et)
  CLS
  PRINT CHR$(13); NPH$(et), "Is THIS the PHONE NUMBER you want (Y/N)?"
  DO
    CHK4$ = UCASE$(INKEY$)
  LOOP UNTIL CHK4$ = "Y" OR CHK4$ = "N"
  IF CHK4$ = "N" THEN
    GOTO 47
  END IF
  PH$(et) = NPH$(et)
  LOCATE 25, 25
  PRINT "SAVED";
  Delay 2
  GOTO 47
74
  CLS
  LOCATE 10, 12
  PRINT "Do you want to SAVE changes (Y/N)?"
  DO
    CHK6$ = UCASE$(INKEY$)
  LOOP UNTIL CHK6$ = "Y" OR CHK6$ = "N"
  IF CHK6$ = "N" OR CHK6$ = "n" THEN
    GOTO 4
  END IF
  LOCATE 12, 15
  PRINT "Are you SURE ?"
  LOCATE 15, 16
  PRINT "1)Y E S"
  LOCATE 17, 16
  PRINT "2) N O"
  DO
    CHK7$ = INKEY$
  LOOP UNTIL CHK7$ = "1" OR CHK7$ = "2"
  IF CHK7$ = "2" THEN
    GOTO 4
  END IF
  OPEN Dirt$ FOR OUTPUT AS 1
  FOR Loop2 = 1 TO Set
    QNQ N$(Loop2)
    QNQ CA$(Loop2)
    QNQ BA$(Loop2)
    QNQ PH$(Loop2)
    PRINT #1, N$(Loop2) + "," + CA$(Loop2) + "," + BA$(Loop2) + "," + PH$(Loop2)
  NEXT Loop2
  CLOSE
  GOTO 4
Delete:
  CLS
  PRINT CHR$(13); N$(et), , BA$(et), PH$(et); STRING$(2, 13)
  PRINT CHR$(13); NPH$(et), "Is THIS the ENTRY you want to DELETE (Y/N)?"
  DO
    CHK4$ = UCASE$(INKEY$)
  LOOP UNTIL CHK4$ = "Y" OR CHK4$ = "N"
  IF CHK4$ = "N" THEN
    GOTO 47
  END IF
  Set = Set - 1
  FOR A = et TO Set
    N$(A) = N$(A + 1)
    BA$(A) = BA$(A + 1)
    CA$(A) = CA$(A + 1)
    PH$(A) = PH$(A + 1)
  NEXT
  LOCATE 25, 25
  PRINT "SAVED";
  Delay 2
  GOTO 47

Eror:
  IF ERR = 53 THEN
    IF Fle THEN
      PRINT "Can't Find "; File$
      ON ERROR GOTO 0
    ELSE
      Fle = 1
      RESUME NEXT
    END IF
  ELSE
    PRINT "Error "; ERR
    ON ERROR GOTO 0
  END IF

SUB Choice (Ch, Sze)
  COLOR A(7), A(8)
  Col1 = Col + 1
  LOCATE Poss(Ch), Col1
  PRINT See$(Ch)
  DO
    DO
      A$ = INKEY$
    LOOP WHILE A$ = ""
    COLOR A(5), A(6)
    LOCATE Poss(Ch), Col1
    PRINT See$(Ch)
    SELECT CASE A$
      CASE CHR$(0) + "H"
        Ch = Ch - 1
        IF Ch = 0 THEN
          Ch = Sze
        END IF
      CASE CHR$(0) + "P"
        Ch = Ch + 1
        IF Ch = Sze + 1 THEN
          Ch = 1
        END IF
      CASE ELSE
    END SELECT
    COLOR A(7), A(8)
    LOCATE Poss(Ch), Col1
    PRINT See$(Ch)
  LOOP UNTIL A$ = CHR$(13)
END SUB

SUB Delay (Sec)
  Hold = TIMER
  Hold = (Hold + Sec) MOD 86400
  DO
    Hold2 = TIMER
    Diff = Hold - Hold2 + 1
    IF Diff < -.5 THEN
      Hold2 = Hold2 - 86400
    END IF
    Diff = Hold - Hold2 + 1
  LOOP WHILE Diff < 0 OR Hold2 < Hold
END SUB

SUB LoadDir (Set)
  OPEN Dirt$ FOR INPUT AS 1
  FOR Loop1 = 1 TO 256
    IF EOF(1) THEN
      EXIT FOR
    END IF
    INPUT #1, N$(Loop1), CA$(Loop1), BA$(Loop1), PH$(Loop1)
  NEXT Loop1
  CLOSE
  Set = Loop1 - 1
END SUB

SUB NewEntry
  DO
    CLS
    COLOR 23
    LOCATE 3
    PRINT "Press <ENTER> to return to Menu."; STRING$(2, 13)
    COLOR 15
    LINE INPUT "NAME: ", N$
    IF N$ > "" THEN
      QNQ N$
      PRINT
      PRINT "Catagory not Displayed YET !!!"
      LINE INPUT "CATAGORY: ", CA$
      QNQ CA$
      PRINT
      PRINT " Example: 10-01-1973"; STRING$(3, 13)
      LINE INPUT "BIRTHDAY: ", B$
      QNQ B$
      PRINT
      PRINT "Example: 706-937-3179"; STRING$(3, 13)
      LINE INPUT "PHONE NUMBER: ", PH$
      QNQ PH$
      PRINT #1, N$ + "," + CA$ + "," + B$ + "," + PH$
    END IF
  LOOP UNTIL N$ = ""
  CLOSE
END SUB

SUB Pather
  ON ERROR GOTO Eror
  Dirt$ = UCASE$(Dirt$)
  IF INSTR(Dirt$, ".") = 0 THEN
    Dirt$ = Dirt$ + ".DIR"
  END IF
  OPEN "I", 1, Dirt$
  CLOSE
  IF Fle = 0 THEN
    EXIT SUB
  END IF
  Path$ = ENVIRON$("PHONE") + ";" + ENVIRON$("PATH") + ";"
  P = INSTR(Path$, ";;")
  DO WHILE P
    Path$ = LEFT$(Path$, P) + MID$(Path$, P + 2)
    P = INSTR(Path$, ";;")
  LOOP
  P = INSTR(Path$, ";")
  DO
    Fle = 0
    P$ = LEFT$(Path$, P - 1) + "\"
    OPEN "I", 1, P$ + Dirt$
    CLOSE
    IF Fle THEN
      Path$ = MID$(Path$, P + 1)
    ELSE
      Dirt$ = P$ + Dirt$
    END IF
    P = INSTR(Path$, ";")
  LOOP WHILE Fle AND Path$ > ""
  IF Fle THEN
    File$ = Dirt$
    ERROR 53
  END IF
END SUB

FUNCTION Poss (Ch)
  Poss = 2 * Ch + Lin
END FUNCTION

SUB PrintDir (Set)
  FOR Loop2 = 1 TO Set
    LPRINT Loop2; TAB(7); N$(Loop2); TAB(46); BA$(Loop2), "  "; PH$(Loop2)
  NEXT Loop2
  LPRINT CHR$(12);
END SUB

SUB QNQ (Srchd$)
  IF INSTR(Srchd$, ",") THEN
    Srchd$ = CHR$(34) + Srchd$ + CHR$(34)
  END IF
END SUB

SUB Search (Set)
  '****** SEARCH SYSTEM ******
  CLS
  LOCATE 11, 12
  LINE INPUT "I WANT THE COMPUTER TO SEARCH FOR: ", Srch$
  CLS
  LOCATE 1
  FOR Ear = 1 TO Set
C = INSTR(UCASE$(" " + N$(Ear) + " " + CA$(Ear) + " " + BA$(Ear) + " " +
    PH$(Ear) + " "), UCASE$(Srch$))
    IF C THEN
      C1 = C1 + 1
      Cock = CSRLIN
      PRINT Ear;
      LOCATE Cock, 7
      PRINT N$(Ear);
      LOCATE Cock, 46
      PRINT BA$(Ear), "   "; PH$(Ear)
      IF C1 MOD 22 = 0 THEN
        PRINT "<PAUSE>";
        K = CSRLIN
        Hld$ = INPUT$(1)
        LOCATE K, 1
        PRINT "       ";
        LOCATE K, 1
      END IF
    END IF
  NEXT
  IF C1 THEN
    IF Cock < 23 THEN
      LOCATE Cock
    ELSE
      LOCATE 24
    END IF
    PRINT STRING$(2, 13), C1; Srch$; " STRING(S) FOUND"
    C1 = 0
  ELSE
    LOCATE 11, 12
    PRINT "SEARCH STRING "; Srch$; " WAS NOT FOUND ....."
  END IF
  LOCATE 25, 8
  PRINT "HIT ANY KEY TO RETURN TO MENU ........";
  DO
    Retu$ = INKEY$
  LOOP WHILE Retu$ = ""
END SUB

SUB Sorter
  '**** ALPHABATIZER ****
  CLS
  LOCATE 12, 5
  PRINT "Please Wait While I Alphabetize the Phone Directory ..........";
  OPEN Dirt$ FOR INPUT AS 1
  FOR A = 1 TO 256
    IF EOF(1) THEN
      EXIT FOR
    END IF
    INPUT #1, A$(A), CA$(A), BI$(A), PH$(A)
    D$(A) = A$(A)
  NEXT
  CLOSE
  Set = A - 1
  FOR R2 = Set TO 1 STEP -1
    FOR A = 1 TO LEN(D$(R2))
      B(A) = INSTR(A, D$(R2), " ")
      IF B(A) <> 0 AND A = B(A) THEN ZIP = ZIP + 1
      IF ZIP = 2 THEN
        ALP$ = MID$(D$(R2), B(A) + 1)
        ALP2$ = LEFT$(D$(R2), B(A) - 1)
        BA$(R2) = ALP$
        A$(R2) = ALP2$
        EXIT FOR
      END IF
    NEXT A
    ZIP = 0
  NEXT R2
  FOR TRIP = 1 TO 2
    FLIPS = 1
    WHILE FLIPS
      FLIPS = 0
      IF PIZZA = 1 THEN
        FOR SW = 1 TO Set
          C$(SW) = BA$(SW)
          SWAP BA$(SW), A$(SW)
        NEXT SW
      END IF
      FOR I = Set - 1 TO 1 STEP -1
        P = I + 1
        IF C$(I) = C$(P) AND BA$(I) > BA$(P) THEN
          SWAP A$(I), A$(P)
          SWAP BA$(I), BA$(P)
          SWAP D$(I), D$(P)
          SWAP CA$(I), CA$(P)
          SWAP BI$(I), BI$(P)
          SWAP PH$(I), PH$(P)
          FLIPS = 1
        END IF
      NEXT I
    WEND
    IF PIZZA = 0 THEN
      PIZZA = 1
    ELSE
      PIZZA = 0
    END IF
  NEXT TRIP
  OPEN Dirt$ FOR OUTPUT AS 1
  FOR A = 1 TO Set
    QNQ N$(A)
    QNQ CA$(A)
    QNQ BA$(A)
    QNQ PH$(A)
    PRINT #1, D$(A) + "," + CA$(A) + "," + BI$(A) + "," + PH$(A)
  NEXT A
  CLOSE
END SUB

SUB ViewDir (Set)
  FOR Loop2 = 1 TO Set
    PRINT Loop2;
    LOCATE , 7
    PRINT N$(Loop2);
    LOCATE , 46
    PRINT BA$(Loop2), "   "; PH$(Loop2)
    IF Loop2 MOD 22 = 0 THEN
      PRINT "<PAUSE>";
      K = CSRLIN
      Hld$ = INPUT$(1)
      LOCATE K, 1
      PRINT "       ";
      LOCATE K, 1
    END IF
  NEXT Loop2
END SUB
'-------------------------------

    Lucius L. Hilley III - Unkmar

new topic     » topic index » view message » categorize

2. Re: GOTO Spaghetti code

Lucius L. Hilley III wrote:
> 
> Spaghetti code:
> 
> This is QBasic conversion of a GW-Basic program that
> I wrote many years ago.  The source had previously never been
> shared.
> 
> Pardon the 7-bit copies of some of the 8-bit characters I used.
> Again, Code resulting from a young self teaching Lucius Hilley.
> 
> A binary copy made available if anyone cares.
> 

Snipping actual code

> 
>     Lucius L. Hilley III - Unkmar

I had asked for an example f spaghetti code originally written less than 5 years
ago (any language).

This doesn't appear to qualify, and no one else cared to show any.

Spaghetti code is as weak as most of the arguments against goto I have seen
tossed aroundhere. That alone would reinforce me in the idea that it certainly
doesn't harm to have it in, even if I don't think I'd use it a lot. I write in
asm if I want top speed.

CChris

new topic     » goto parent     » topic index » view message » categorize

3. Re: GOTO Spaghetti code

CChris wrote:
> 

> 
> I had asked for an example of spaghetti code originally written less than
> 5 years ago (any language).

Ok, this isn't 5 years old.  Closer to 10, but it is my all time favorite
example of spaghetti code:

http://www.telusplanet.net/public/stonedan/code.txt

At least it has flow charts:
http://www.telusplanet.net/public/stonedan/pict01.htm

For more info on the author:

http://www.thestupidestmanonearth.com/

Matt

new topic     » goto parent     » topic index » view message » categorize

4. Re: GOTO Spaghetti code

I was unable to resolve the uses of goto into something else
at the time in which I converted the code.  This isn't all
that amazing since it was my first experience with procedural
programming.  I took another look at the code last night and
was able to resolve one of the labels into a loop.  I didn't
get beyond that before the sandman visited.

    Cheers
    Lucius L. Hilley III - Unkmar

new topic     » goto parent     » topic index » view message » categorize

Search



Quick Links

User menu

Not signed in.

Misc Menu