PureBasic Forums - English

Code: Select all

Global Dim mt.s(255)  ; (m)onofont (t)ext
Global mti.i
Global dspMode.i
Global X, Y
Global Dim c.i(52, 32)
For i = 0 To 52
  c(i, 0) = 1
Next
For i = 0 To 52 Step 6
  c(i, 32) = 1
Next


Procedure pr(mt.s)
  mt(mti) + mt
EndProcedure

Procedure prn(mt.s, n = 1)
  pr(mt)
  For i = 1 To n
    mti + 1
  Next
EndProcedure

Procedure dsp(mt.s)
  pr(mt)
  X = 0
  Y = 0
  If dspMode = 0
    For i = 0 To mti
      Debug mt(i)
    Next
  EndIf
  If dspMode = 1
    msg.s = ""
    For i = 0 To mti
      msg + mt(i) + Chr(10)
    Next
    MessageRequester("", msg)
  EndIf
  If dspMode = 2
    StartDrawing(ScreenOutput() )
    For i = 0 To mti
      DrawText(X, Y, mt(i), RGB(255, 255, 255), RGB(0, 0, 0) )
      Y + TextHeight(mt(i) )
    Next
    StopDrawing()
    FlipBuffers()
  EndIf
  If dspMode = 3
    StartDrawing(ScreenOutput() )
    For i = 0 To mti
      lmt = Len(mt(i) )
      jX = 0
      For j = 1 To lmt
        a = Asc(UCase(Mid(mt(i), j, 1) ) )
        If a = ' ': ch = 0: EndIf
        If a = '!': ch = %0010000100001000000000100: EndIf
        If a = '=': ch = %0000011110000001111000000: EndIf
        If a = '$': ch = %0111110100011100010111110: EndIf
        If a = '*': ch = %0010010101011101010100100: EndIf
        If a = ':': ch = %0110001100000000110001100: EndIf
        If a = '\': ch = %1000001000001000001000001: EndIf
        If a = '_': ch = %0000000000000000000011111: EndIf
        If a = 'A': ch = %0111010001111111000110001: EndIf
        If a = 'B': ch = %1111010001111101000111110: EndIf
        If a = 'C': ch = %0111010001100001000101110: EndIf
        If a = 'D': ch = %1111010001100011000111110: EndIf
        If a = 'E': ch = %1111110000111001000011111: EndIf
        If a = 'F': ch = %1111110000111001000010000: EndIf
        If a = 'G': ch = %0111110000101111000101111: EndIf
        If a = 'H': ch = %1000110001111111000110001: EndIf
        If a = 'I': ch = %0111000100001000010001110: EndIf
        If a = 'J': ch = %0001100001000011000101110: EndIf
        If a = 'K': ch = %1000110010111001001010001: EndIf
        If a = 'L': ch = %1000010000100001000011111: EndIf
        ;        If a = 'M': ch = %1000111011101011000111011: EndIf
        If a = 'M': ch = %1000111111100011000110001: EndIf
        If a = 'N': ch = %1000111001101011001110001: EndIf
        If a = 'O': ch = %0111010001100011000101110: EndIf
        If a = 'P': ch = %1111010001111101000010000: EndIf
        If a = 'Q': ch = %0111010001101011001001101: EndIf
        If a = 'R': ch = %1111010001111101000110001: EndIf
        If a = 'S': ch = %0111110000011100000111110: EndIf
        If a = 'T': ch = %1111100100001000010000100: EndIf
        If a = 'U': ch = %1000110001100011000101110: EndIf
        If a = 'V': ch = %1000110001100010101000100: EndIf
        If a = 'W': ch = %1000110001101011101110001: EndIf
        If a = 'X': ch = %1000101010001000101010001: EndIf
        If a = 'Y': ch = %1000101010001000010001110: EndIf
        If a = 'Z': ch = %1111100010001000100011111: EndIf
        If a = '.': ch = %0000000000000000110001100: EndIf
        If a = '0': ch = %0111010011101011100101110: EndIf
        If a = '1': ch = %0010001100101000010011111: EndIf
        If a = '2': ch = %1111000001011101000011111: EndIf
        If a = '3': ch = %1111000001001100000111110: EndIf
        If a = '4': ch = %0011001010100101111100010: EndIf
        If a = '5': ch = %1111110000111100000111110: EndIf
        If a = '6': ch = %0111110000111101000101110: EndIf
        If a = '7': ch = %1111100001000100010000100: EndIf
        If a = '8': ch = %0111010001011101000101110: EndIf
        If a = '9': ch = %0111010001011110000111110: EndIf
        If a = 219: ch = %1111111111111111111111111: EndIf
        If ((a >= 'A' And a =< 'Z') Or (a >= '0' And a =< '9') ) And 1
          If a <> 'N'
            mask = ch & %1000010000100001000010000
            If mask
              mask >> 1
              ch | mask
            EndIf
            mask = ch & %0000100001000010000100001
            If mask
              mask << 1
              ch | mask
            EndIf
          Else
            ch = %1001111011111111101111001
            EndIf ;
          EndIf
         c0 = RGB(127, 63, 31)
         c = RGB(255, 127, 63)
         If j-1<0 Or j-1>52 Or I<0 Or I>32
           Debug i
          Debug j
           End
         EndIf
         If c(j-1,i)
            Box(X + jX, Y, 7, 7, c)
         EndIf
          For iY = 0 To 4
            For iX = 0 To 4
              If Bool(ch & (1 << ((4 - iY) * 5 + (4 - iX) ) ) ) XOr c(j-1,i)
                If c(j-1,i) <> 1
                  Box(X + jX + iX + 1, Y + iY + 1, 2, 2, 0)
                EndIf
                Box(X + jX + iX + 1, Y + iY + 1, 1, 1, c)
              Else
                Box(X + jX + iX + 1, Y + iY + 1, 1, 1, c0)
              EndIf
            Next
          Next
          jX + 6
        Next
        Y + 6
      Next
      StopDrawing()
      FlipBuffers()
    EndIf
  EndProcedure
  
  Procedure clk(duration)
    t0 = ElapsedMilliseconds()
    Repeat
      clk = ElapsedMilliseconds()
      Delay(8)
      ClearScreen(RGB(127, 63, 31) )
      ExamineKeyboard()
      ExamineMouse()
      mt(0) = Left(mt(0), 50) + Right("  " + Str((t0 + duration - clk) / 1000), 3)
      dsp("")
    Until clk > t0 + duration Or KeyboardPushed(#PB_Key_Escape) Or MouseButton(#PB_MouseButton_Right)
  EndProcedure
  
  ;-
  
  preFile.s = GetCurrentDirectory()
  preFile.s = "...\"
  pr(preFile + "UNTITLED.BAS")
  mt(mti) + Space(53 - Len(mt(mti) ) )
  prn("")
  pr("VIDEO...")
  If InitSprite()
    prn("OK")
    dspMode = 1
    pr("SCREEN...")
    If OpenScreen(320, 200, 32, "")
      prn("OK")
      dspMode = 2
      pr("KEYBOARD...")
      If InitKeyboard()
        prn("OK")
        pr("MOUSE...")
        If InitMouse()
          prn("OK")
          pr("MODE 52*32...")
          
          dspMode = 3
          prn("OK")
          prn("OK")
          prn("A$=B$"+Chr(219) )
          prn("", 24)
          prn("1HELP 2PROC 3FIND 4SAVE 5EXEC 6LOAD 7UNDO 8CLIP 9QUIT")
          clk(5 * 60000)
        Else
          dsp("FAILED")
        EndIf
      Else
        dsp("FAILED")
      EndIf    
    Else
      dsp("FAILED")
    EndIf
  Else
    dsp("FAILED")
  EndIf

Code: Select all

PROGRAMMER LEVEL
10 ----|     Dennis Ritchie, Linus Torvalds, Thomas Kurtz, Fread, Freak and all PB team
 9 ----|     
 8 ----|     
 7 ----|     
 6 ----|     
 5 ----|     
 4 ----|     
 3 ----|     
 2 ----|     Next door girl (is a mistery)
 1 ----|     The postman (He doesn't use email)
 0 ----|     My wife (can count the money in my wallet and shop online)
-1 ----|     My level (mmm!.. what was the question?, I can count beers and days off)
-2 ----|     My uncle (can use a calculator)
-3 ----|     The Neighbor Below (He knows how to count the blows he gives on the wall)
-4-----|     Atila (Where his horse trod, no one reprogrammed)
-5 ----|     Homo habilis (They could do calculations with stones and sticks)