'===========================================================================
' Subject: EGA ANIMATION OF MAN WALKING      Date: Unknown Date (00:00:00)
' Author:  Steve Demo                        Code: QB, QBasic             
' Keys:    EGA,ANIMATION,WALKING           Packet: GRAPHICS.ABC
'===========================================================================
'Written By Steve Demo for Public Domain !
'Any and all source may be mangled, distroyed, burned, copied, or deleted as
'you see fit :-).
'
'I have only directed my intrests in Graphics with in the last month or so
'and this is what I have come up with so far.
'The moveing images were created by a program I wrote using Rich's Gif
'engine. It is fairly simple to make for your self just study the POINT
'function and you should be able to make one to. As you will notice I am
'not much of an artist and this is just a quick Demo anyways.
'
'I have also been able to make a space ship move and fire a laser. And
'distory the object fired on. If you would like to see this code drop me
'a note.


DEFINT A-Z
DECLARE SUB ManWalk1 (newx, newy)
DECLARE SUB ManWalk2 (newx, newy)
DECLARE SUB ManWalk3 (newx, newy)
DECLARE SUB ManWalk4 (newx, newy)
DECLARE SUB ManWalk5 (newx, newy)
DECLARE SUB DrawScreen ()
DECLARE SUB Pause (ticks%)
REM $DYNAMIC
REDIM BackArray%(250)

SCREEN 7, , 1, 0

DrawScreen

Xpos% = 160
GET (Ypos%, Xpos%)-(Ypos% + 13, Xpos% + 18), BackArray%
old.Ypos% = Ypos%
old.Xpos% = Xpos%
yes = 1
PCOPY 1, 2
DO
COLOR , 0
count = 0
PCOPY 2, 1
 GET (old.Ypos%, old.Xpos%)-(old.Ypos% + 13, old.Xpos% + 18), BackArray%
 Runcount = 1
 FOR Ypos% = 5 TO 290 STEP 2
   count = count + 1
   yes = yes + 1
    IF LEN(INKEY$) THEN EXIT DO
   KeyPress$ = ""
   PUT (old.Ypos%, old.Xpos%), BackArray%, PSET
   GET (Ypos%, Xpos%)-(Ypos% + 13, Xpos% + 18), BackArray%
  'LINE (Ypos%, Xpos%)-(Ypos% + 13, Xpos% + 18), 10, B   '  To test GET
  'SOUND 700, .05
    IF yes > 1 THEN
        ManWalk2 Xpos%, Ypos%
        yes = 0
    ELSE
        ManWalk1 Xpos%, Ypos%
    END IF
    IF count > 30 THEN
        PUT (Ypos%, Xpos%), BackArray%, PSET
        GET (Ypos%, Xpos%)-(Ypos% + 13, Xpos% + 18), BackArray%
        ManWalk3 Xpos%, Ypos%
        PCOPY 1, 0
        Pause 12
        count = 0
    END IF
  PCOPY 1, 0
  old.Ypos% = Ypos%
  old.Xpos% = Xpos%
  Pause 2
 NEXT Ypos%

 FOR alarm = 1 TO 15
   'PLAY "t180l60<<<dgdgda>>>"
 NEXT alarm

 FOR x = 1 TO 320 STEP 5
    LINE (x, 205)-(1, x), 10
 NEXT x

PAINT (163, 148), 12, 1
PAINT (250, 24), 14, 3
LINE (162, 147)-(188, 178), 4, B
COLOR , 9
FOR Ypos% = 290 TO 10 STEP -3
  yes = yes + 1
   IF LEN(INKEY$) THEN EXIT DO
  PUT (old.Ypos%, old.Xpos%), BackArray%, PSET
  GET (Ypos%, Xpos%)-(Ypos% + 13, Xpos% + 18), BackArray%
  'LINE (Ypos%, Xpos%)-(Ypos% + 13, Xpos% + 18), 10, B   '  To test GET
  'SOUND 400, .05
  'SOUND 700, .05
   IF yes > 1 THEN
      ManWalk5 Xpos%, Ypos%
      yes = 0
   ELSE
      ManWalk4 Xpos%, Ypos%
   END IF
  PCOPY 1, 0
  old.Ypos% = Ypos%
  old.Xpos% = Xpos%
  Pause 1
 NEXT Ypos%

LOOP

REM $STATIC
SUB DrawScreen
RANDOMIZE TIMER
FOR xx = 1 TO 300
    x = RND * 320
    y = RND * 200
    PSET (x, y), 15
NEXT xx
LINE (1, 170)-(320, 200), 1, BF
 FOR x = 1 TO 320 STEP 5
     LINE (x, 205)-(1, x), 7
 NEXT x
LINE (263, 165)-(309, 189), 7, BF
LINE (265, 166)-(308, 187), 0, B
LINE (267, 168)-(306, 185), 0, B
LINE (270, 171)-(303, 183), 1, BF
LINE (160, 145)-(190, 180), 5, BF
LINE (162, 147)-(188, 178), 1, B
LINE (165, 150)-(185, 175), 4, BF
CIRCLE (250, 24), 25, 3
PAINT (250, 24), 8, 3

END SUB

SUB ManWalk1 (newx, newy)
'$DYNAMIC
REDIM F(190)
F(5) = 6: F(6) = 6: F(7) = 6:
F(12) = 6: F(13) = 6: F(14) = 6: F(15) = 6: F(16) = 14: F(17) = 6: F(20) = 6: F(21) = 6: F(22) = 6:
F(23) = 6: F(24) = 14: F(25) = 14: F(26) = 14: F(28) = 6: F(29) = 6: F(30) = 6: F(31) = 6: F(32) = 14: F(33) = 14:
F(34) = 9: F(35) = 14: F(37) = 6: F(38) = 6: F(39) = 14: F(40) = 14: F(41) = 14: F(42) = 14: F(43) = 14: F(44) = 14:
F(45) = 14: F(46) = 6: F(47) = 6: F(48) = 6: F(49) = 14: F(50) = 14: F(51) = 14: F(52) = 14: F(53) = 14: F(55) = 6:
F(56) = 6: F(57) = 6: F(58) = 14: F(59) = 14: F(60) = 14: F(61) = 4: F(65) = 6: F(66) = 6:
F(67) = 14: F(68) = 14: F(69) = 14: F(70) = 14: F(77) = 14:
F(85) = 11: F(86) = 3: F(87) = 3: F(94) = 11: F(95) = 3:
F(96) = 3: F(103) = 11: F(104) = 11: F(105) = 11:
F(113) = 3: F(114) = 11: F(115) = 11: F(121) = 3: F(122) = 3: F(123) = 3:
F(130) = 3: F(132) = 3: F(140) = 3:
F(142) = 3: F(148) = 3: F(151) = 3:
F(156) = 10: F(157) = 10: F(160) = 10: F(161) = 10:
d = 0
   FOR x = newx TO newx + 17
      FOR xxx = newy TO newy + 8
       d = d + 1
       PixielColor = F(d)
      IF PixielColor <> 0 THEN
        IF POINT(xxx, x) <> 7 THEN
           PSET (xxx, x), PixielColor
        END IF
      END IF
      NEXT xxx
   NEXT x

ERASE F
END SUB

REM $STATIC
SUB ManWalk2 (newx, newy)
'$DYNAMIC
REDIM F(171)

F(4) = 6: F(5) = 6: F(6) = 6: F(10) = 6: F(11) = 6: F(12) = 6: F(13) = 6: F(14) = 14:
F(15) = 6: F(17) = 6: F(18) = 6: F(19) = 6: F(20) = 6: F(21) = 14: F(22) = 14: F(23) = 14: F(25) = 6:
F(26) = 6: F(27) = 6: F(28) = 14: F(29) = 14: F(30) = 9: F(31) = 14: F(33) = 6: F(34) = 14: F(35) = 14: F(36) = 14:
F(37) = 14: F(38) = 14: F(39) = 14: F(40) = 14: F(41) = 6: F(42) = 6: F(43) = 14: F(44) = 14: F(45) = 14: F(46) = 14: F(47) = 14:
F(49) = 6: F(50) = 6: F(51) = 14: F(52) = 14: F(53) = 14: F(54) = 4: F(57) = 6: F(58) = 6: F(59) = 14:
F(60) = 14: F(61) = 14: F(62) = 14: F(68) = 14:
F(75) = 11: F(76) = 11: F(77) = 3: F(83) = 11: F(84) = 11: F(85) = 3:
F(90) = 11: F(91) = 11: F(92) = 3: F(93) = 3: F(98) = 11: F(100) = 3:
F(101) = 3: F(107) = 3: F(108) = 3: F(109) = 3:
F(115) = 3: F(117) = 3: F(123) = 3:
F(126) = 3: F(130) = 3: F(133) = 3:
F(138) = 10: F(139) = 10: F(142) = 10: F(143) = 10:
d = 0
   FOR x = newx TO newx + 17
      FOR xxx = newy TO newy + 7
       d = d + 1
       PixielColor = F(d)
     
      IF PixielColor <> 0 THEN
        IF POINT(xxx, x) <> 7 THEN
           PSET (xxx, x), PixielColor
        END IF
      END IF
     
      NEXT xxx
   NEXT x

ERASE F
END SUB

REM $STATIC
SUB ManWalk3 (newx, newy)
'$DYNAMIC
REDIM F(220)

F(13) = 6: F(14) = 6: F(15) = 6: F(16) = 6: F(20) = 6: F(21) = 6: F(22) = 6: F(23) = 6:
F(24) = 6: F(25) = 6: F(26) = 6: F(28) = 6: F(29) = 6: F(30) = 6: F(31) = 6: F(32) = 14: F(33) = 14: F(34) = 6:
F(35) = 6: F(37) = 6: F(38) = 6: F(39) = 14: F(40) = 9: F(41) = 14: F(42) = 9: F(43) = 14: F(44) = 6: F(45) = 6:
F(46) = 6: F(47) = 14: F(48) = 14: F(49) = 14: F(50) = 14: F(51) = 14: F(52) = 14: F(53) = 14: F(54) = 6: F(55) = 6: F(56) = 6:
F(57) = 14: F(58) = 14: F(59) = 14: F(60) = 14: F(61) = 14: F(62) = 6: F(63) = 6: F(64) = 6: F(65) = 6: F(66) = 14: F(67) = 4:
F(68) = 4: F(69) = 4: F(70) = 14: F(71) = 6: F(72) = 6: F(73) = 6: F(74) = 6: F(75) = 14: F(76) = 14: F(77) = 14: F(78) = 14:
F(79) = 14: F(80) = 6: F(85) = 14: F(86) = 14:
F(93) = 11: F(94) = 3: F(95) = 3: F(102) = 11: F(103) = 3:
F(104) = 3: F(111) = 11: F(112) = 11: F(113) = 11:
F(121) = 3: F(122) = 11: F(123) = 11: F(129) = 3: F(130) = 3: F(131) = 3:
F(138) = 3: F(140) = 3: F(148) = 3:
F(150) = 3: F(156) = 3: F(159) = 3:
F(165) = 10: F(166) = 10: F(168) = 10: F(169) = 10:
d = 0
   FOR x = newx TO newx + 20
      FOR xxx = newy TO newy + 8
       d = d + 1
       PixielColor = F(d)
      IF PixielColor <> 0 THEN
        IF POINT(xxx, x) <> 7 THEN
           PSET (xxx, x), PixielColor
        END IF
      END IF
     
      NEXT xxx
   NEXT x

ERASE F
END SUB

REM $STATIC
SUB ManWalk4 (newx, newy)
'$DYNAMIC
REDIM F(200)

F(12) = 6: F(13) = 6: F(14) = 6: F(20) = 6: F(21) = 14: F(22) = 6:
F(23) = 6: F(24) = 6: F(25) = 6: F(29) = 14: F(30) = 14: F(31) = 14: F(32) = 6: F(33) = 6:
F(34) = 6: F(35) = 6: F(38) = 14: F(39) = 9: F(40) = 14: F(41) = 14: F(42) = 6: F(43) = 6: F(44) = 6:
F(45) = 6: F(46) = 14: F(47) = 14: F(48) = 14: F(49) = 14: F(50) = 14: F(51) = 14: F(52) = 14: F(53) = 6: F(54) = 6:
F(56) = 14: F(57) = 14: F(58) = 14: F(59) = 14: F(60) = 14: F(61) = 6: F(62) = 6: F(63) = 6: F(66) = 4:
F(67) = 14: F(68) = 14: F(69) = 14: F(70) = 6: F(71) = 6: F(72) = 6: F(75) = 14: F(76) = 14: F(77) = 14:
F(78) = 14: F(79) = 6: F(80) = 6: F(86) = 14:
F(94) = 3: F(95) = 11: F(96) = 11: F(103) = 3: F(104) = 11:
F(105) = 11: F(112) = 3: F(113) = 3: F(114) = 11: F(115) = 11:
F(121) = 3: F(122) = 3: F(124) = 11: F(130) = 3: F(131) = 3:
F(132) = 3: F(139) = 3: F(141) = 3:
F(147) = 3: F(150) = 3: F(157) = 3:
F(160) = 3: F(165) = 10: F(166) = 10: F(168) = 10: F(169) = 10:
d = 0
   FOR x = newx TO newx + 18
      FOR xxx = newy TO newy + 8
       d = d + 1
       PixielColor = F(d)
      TestPoint = POINT(xxx, x)
      IF PixielColor <> 0 THEN
        IF TestPoint <> 7 AND TestPoint <> 10 AND TestPoint <> 12 THEN
           PSET (xxx, x), PixielColor
        END IF
      END IF
     
      NEXT xxx
   NEXT x

ERASE F
END SUB

REM $STATIC
SUB ManWalk5 (newx, newy)
'$DYNAMIC

REDIM F(200)

F(12) = 6: F(13) = 6: F(14) = 6: F(20) = 6: F(21) = 14: F(22) = 6:
F(23) = 6: F(24) = 6: F(25) = 6: F(29) = 14: F(30) = 14: F(31) = 14: F(32) = 6: F(33) = 6:
F(34) = 6: F(35) = 6: F(38) = 14: F(39) = 9: F(40) = 14: F(41) = 14: F(42) = 6: F(43) = 6: F(44) = 6:
F(45) = 6: F(46) = 14: F(47) = 14: F(48) = 14: F(49) = 14: F(50) = 14: F(51) = 14: F(52) = 14: F(53) = 6: F(54) = 6:
F(56) = 14: F(57) = 14: F(58) = 14: F(59) = 14: F(60) = 14: F(61) = 6: F(62) = 6: F(63) = 6: F(66) = 4:
F(67) = 14: F(68) = 14: F(69) = 14: F(70) = 6: F(71) = 6: F(72) = 6: F(75) = 14: F(76) = 14: F(77) = 14:
F(78) = 14: F(79) = 6: F(80) = 6: F(86) = 14:
F(94) = 3: F(95) = 11: F(96) = 11: F(103) = 3: F(104) = 11:
F(105) = 11: F(112) = 3: F(113) = 3: F(114) = 11: F(115) = 11:
F(121) = 3: F(122) = 3: F(124) = 11: F(130) = 3: F(131) = 3:
F(133) = 3: F(139) = 3: F(141) = 3:
F(147) = 3:  F(151) = 3: F(156) = 3:
'F(160) = 3: F(165) = 10: F(166) = 10: F(168) = 10: F(169) = 10:
F(159) = 3: F(165) = 10: F(166) = 10: F(168) = 10: F(169) = 10:
d = 0
   FOR x = newx TO newx + 18
      FOR xxx = newy TO newy + 8
       d = d + 1
       PixielColor = F(d)
      TestPoint = POINT(xxx, x)
      IF PixielColor <> 0 THEN
        IF TestPoint <> 7 AND TestPoint <> 10 AND TestPoint <> 12 THEN
           PSET (xxx, x), PixielColor
        END IF
      END IF
      NEXT xxx
   NEXT x
ERASE F
END SUB

REM $STATIC
 SUB Pause (ticks%)
    '**** ticks% are 1/18th second
    DEF SEG = 0
    DO UNTIL TestTick% > ticks%
        LastTick% = GetTick%
        GetTick% = PEEK(&H46C)
        IF LastTick% <> GetTick% THEN
            TestTick% = TestTick% + 1
        END IF
    LOOP
    DEF SEG
 END SUB