/* ARM assembly Raspberry PI  */
/*  program dpixel.s        */

/* compile with as         */
/* link with gcc and options -lX11 -L/usr/lpp/X11/lib   */

/********************************************/
/*Constantes                                */
/********************************************/
.equ STDOUT,              1     @ Linux output console
.equ EXIT,                1     @ Linux syscall
.equ WRITE,               4     @ Linux syscall
/* constantes X11 */
.equ KeyPressed,          2
.equ ButtonPress,         4
.equ MotionNotify,        6
.equ EnterNotify,         7
.equ LeaveNotify,         8
.equ Expose,              12
.equ ClientMessage,       33
.equ KeyPressMask,        1
.equ ButtonPressMask,     4
.equ ButtonReleaseMask,   8
.equ ExposureMask,        1<<15
.equ StructureNotifyMask, 1<<17
.equ EnterWindowMask,     1<<4
.equ LeaveWindowMask,     1<<5
.equ ConfigureNotify,     22

/*******************************************/
/* DONNEES INITIALISEES                    */
/*******************************************/
.data
szWindowName:            .asciz "Windows Raspberry"
szRetourligne:           .asciz  "\n"
szMessDebutPgm:          .asciz "Program start. \n"
szMessErreur:            .asciz "Server X not found.\n"
szMessErrfen:            .asciz "Can not create window.\n"
szMessErreurX11:         .asciz "Error call function X11. \n"
szMessErrGc:             .asciz "Can not create graphics context.\n"
szTitreFenRed:           .asciz "Pi"
szTexte1:                .asciz "<- red pixel is here !!"
.equ LGTEXTE1, . - szTexte1
szTexte2:                .asciz "Press q for close window or clic X in system menu."
.equ LGTEXTE2, . - szTexte2
szLibDW: .asciz "WM_DELETE_WINDOW"    @ special label for correct close error

/*************************************************/
szMessErr: .ascii	"Error code hexa : "
sHexa: .space 9,' '
         .ascii "  decimal :  "
sDeci: .space 15,' '
         .asciz "\n"

/*******************************************/
/* DONNEES NON INITIALISEES                    */
/*******************************************/
.bss
.align 4
ptDisplay:          .skip 4      @ pointer display
ptEcranDef:         .skip 4      @ pointer screen default
ptFenetre:          .skip 4      @ pointer window
ptGC:               .skip 4      @ pointer graphic context
ptGC1:              .skip 4      @ pointer graphic context1
key:                .skip 4      @ key code
wmDeleteMessage:    .skip 8      @ ident close message
event:              .skip 400    @ TODO event size ??
PrpNomFenetre:      .skip 100    @ window name proprety
buffer:             .skip 500
iWhite:             .skip 4      @ rgb code for white pixel
iBlack:             .skip 4      @ rgb code for black pixel
/**********************************************/
/* -- Code section                            */
/**********************************************/
.text
.global main

main:                               @ entry of program
    ldr r0,iAdrszMessDebutPgm   @
    bl affichageMess            @ display start message on console linux
    /* attention r6  pointer display*/
    /* attention r8  pointer graphic context   */
    /* attention r9 ident window  */
    /*****************************/
    /*    OPEN SERVER X11        */
    /*****************************/
    mov r0,#0
    bl XOpenDisplay             @ open X server
    cmp r0,#0                   @ error ?
    beq erreurServeur
    ldr r1,iAdrptDisplay
    str r0,[r1]                 @ store display address
    mov r6,r0                   @ and in register r6
    ldr r2,[r0,#+132]           @ load default_screen
    ldr r1,iAdrptEcranDef
    str r2,[r1]                 @ store default_screen
    mov r2,r0
    ldr r0,[r2,#+140]           @ load pointer screen list
    ldr r5,[r0,#+52]            @ load value white pixel
    ldr r4,iAdrWhite            @ and store in memory
    str r5,[r4]
    ldr r3,[r0,#+56]            @ load value black pixel
    ldr r4,iAdrBlack            @ and store in memory
    str r3,[r4]
    ldr r4,[r0,#+28]            @ load bits par pixel
    ldr r1,[r0,#+8]             @ load root windows
    /**************************/
    /* CREATE WINDOW          */
    /**************************/
    mov r0,r6                   @ address display
    mov r2,#0                   @ window position X
    mov r3,#0                   @ window position Y
    mov r8,#0                   @ for stack alignement
    push {r8}
    push {r3}                   @  background  = black pixel
    push {r5}                   @  border = white pixel
    mov r8,#2                   @  border size
    push {r8}
    mov r8,#240                 @ hauteur
    push {r8}
    mov r8,#320                 @ largeur
    push {r8}
    bl XCreateSimpleWindow
    add sp,#24                  @ stack alignement  6 push (4 bytes * 6)
    cmp r0,#0                   @ error ?
    beq erreurF

    ldr r1,iAdrptFenetre
    str r0,[r1]                 @ store window address in memory
    mov r9,r0                   @ and in register r9
    /*****************************/
    /* add window property       */
    /*****************************/
    mov r0,r6                   @ display address
    mov r1,r9                   @ window address
    ldr r2,iAdrszWindowName     @ window name
    ldr r3,iAdrszTitreFenRed    @ window name reduced
    mov r4,#0
    push {r4}                   @ parameters not use
    push {r4}
    push {r4}
    push {r4}
    bl XSetStandardProperties
    add sp,sp,#16               @ stack alignement for 4 push
    /**************************************/
    /* for correction window close error  */
    /**************************************/
    mov r0,r6                   @ display address
    ldr r1,iAdrszLibDW          @ atom address
    mov r2,#1                   @ False  créate atom if not exists
    bl XInternAtom
    cmp r0,#0                   @ error X11 ?
    ble erreurX11
    ldr r1,iAdrwmDeleteMessage  @ recept address
    str r0,[r1]
    mov r2,r1                   @ return address
    mov r0,r6                   @ display address
    mov r1,r9                   @ window address
    mov r3,#1                   @ number of protocols
    bl XSetWMProtocols
    cmp r0,#0                   @ error X11 ?
    ble erreurX11
    /**********************************/
    /*  create graphic context        */
    /**********************************/
    mov r0,r6                   @ display address
    mov r1,r9                   @ window address
    mov r2,#0                   @ not use for simply context
    mov r3,#0
    bl XCreateGC
    cmp r0,#0                   @ error ?
    beq erreurGC
    ldr r1,iAdrptGC
    str r0,[r1]                 @ store address graphic context
    mov r8,r0                   @ and in r8
    @ create other GC
    mov r0,r6                   @ display address
    mov r1,r9                   @ window address
    mov r2,#0                   @ not use for simply context
    mov r3,#0
    bl XCreateGC
    cmp r0,#0                   @ error ?
    beq erreurGC
    ldr r1,iAdrptGC1
    str r0,[r1]                 @ store address graphic context 1
    mov r1,r0
    mov r0,r6
    mov r2,#0xFF0000            @ color red
    bl XSetForeground
    cmp r0,#0
    beq erreurGC
    /****************************/
    /* modif window background  */
    /****************************/
    mov r0,r6                   @ display address
    mov r1,r9                   @ window address
    ldr r2,iGris1               @ background color
    bl XSetWindowBackground
    cmp r0,#0                   @ error ?
    ble erreurX11
    /***************************/
    /* OUF!! window display    */
    /***************************/
    mov r0,r6                   @ display address
    mov r1,r9                   @ window address
    bl XMapWindow
    /****************************/
    /* Write text1 in the window */
    /****************************/
    mov r0,r6                   @ display address
    mov r1,r9                   @ window address
    mov r2,r8                   @ address graphic context
    mov r3,#105                 @ position x
    sub sp,#4                   @ stack alignement
    mov r4,#LGTEXTE1  - 1       @ size string
    push {r4}                   @ on the stack
    ldr r4,iAdrszTexte1         @ string address
    push {r4}
    mov r4,#105                 @ position y
    push {r4}
    bl XDrawString
    add sp,sp,#16               @ stack alignement 3 push and 1 stack alignement
    cmp r0,#0                   @ error ?
    blt erreurX11
    /****************************/
    /* Write text2 in the window */
    /****************************/
    mov r0,r6                   @ display address
    mov r1,r9                   @ window address
    mov r2,r8                   @ address graphic context
    mov r3,#10                  @ position x
    sub sp,#4                   @ stack alignement
    mov r4,#LGTEXTE2  - 1       @ size string
    push {r4}                   @ on the stack
    ldr r4,iAdrszTexte2         @ string address
    push {r4}
    mov r4,#200                 @ position y
    push {r4}
    bl XDrawString
    add sp,sp,#16               @ stack alignement 3 push and 1 stack alignement
    cmp r0,#0                   @ error ?
    blt erreurX11
    /****************************************/
    /* draw pixel                           */
    /****************************************/
    mov r0,r6                   @ display address
    mov r1,r9                   @ window address
    ldr r2,iAdrptGC1
    ldr r2,[r2]                 @  address graphic context 1
    mov r3,#100                 @ position x
    sub sp,sp,#4                @ stack alignement
    mov r4,#100                 @ position y
    push {r4}                   @ on the stack
    bl XDrawPoint
    add sp,sp,#8                @ stack alignement 1 push and 1 stack alignement

    cmp r0,#0                   @ error ?
    blt erreurX11
    /****************************/
    /* Autorisations            */
    /****************************/
    mov r0,r6                   @ display address
    mov r1,r9                   @ window address
    ldr r2,iFenetreMask         @ autorisation mask
    bl XSelectInput
    cmp r0,#0                   @ error ?
    ble erreurX11
    /****************************/
    /* Events loop              */
    /****************************/
1:
    mov r0,r6                   @ display address
    ldr r1,iAdrevent            @ events address
    bl XNextEvent               @ event ?
    ldr r0,iAdrevent
    ldr r0,[r0]                 @ code event
    cmp r0,#KeyPressed          @ key ?
    bne 2f
    ldr r0,iAdrevent            @ yes read key in buffer
    ldr r1,iAdrbuffer
    mov r2,#255
    ldr r3,iAdrkey
    mov r4,#0
    push {r4}                   @ stack alignement
    push {r4}
    bl XLookupString
    add sp,#8                   @ stack alignement 2 push
    cmp r0,#1                   @ is character key ?
    bne 2f
    ldr r0,iAdrbuffer           @ yes -> load first buffer character
    ldrb r0,[r0]
    cmp r0,#0x71                @ character q for quit
    beq 5f                      @ yes -> end
    b 4f
2:
    /*                                  */
    /* for example  clic mouse button   */
    /************************************/
    cmp r0,#ButtonPress         @ clic mouse buton
    bne 3f
    ldr r0,iAdrevent
    ldr r1,[r0,#+32]            @ position X mouse clic
    ldr r2,[r0,#+36]            @ position Y
    @ etc for eventuel use
    b 4f
3:
    cmp r0,#ClientMessage       @ code for close window within error
    bne 4f
    ldr r0,iAdrevent
    ldr r1,[r0,#+28]            @ code message address
    ldr r2,iAdrwmDeleteMessage  @ equal code window créate ???
    ldr r2,[r2]
    cmp r1,r2
    beq 5f                      @ yes -> end window

4:  @ loop for other event
    b 1b
    /***********************************/
    /* Close window -> free ressources */
    /***********************************/
5:
    mov r0,r6                  @ display address
    ldr r1,iAdrptGC
    ldr r1,[r1]                @ load context graphic address
    bl XFreeGC
    cmp r0,#0
    blt erreurX11
    mov r0,r6                  @ display address
    mov r1,r9                  @ window address
    bl XDestroyWindow
    cmp r0,#0
    blt erreurX11
    mov r0,r6                  @ display address
    bl XCloseDisplay
    cmp r0,#0
    blt erreurX11
    mov r0,#0                  @ return code OK
    b 100f
erreurF:   @ create error window but possible not necessary. Display error by server
    ldr r1,iAdrszMessErrfen
    bl   displayError
    mov r0,#1                  @ return error code
    b 100f
erreurGC:                      @ error create graphic context
    ldr r1,iAdrszMessErrGc
    bl   displayError
    mov r0,#1
    b 100f
erreurX11:    @ erreur X11
    ldr r1,iAdrszMessErreurX11
    bl   displayError
    mov r0,#1
    b 100f
erreurServeur:                 @ error no found X11 server see doc putty and Xming
    ldr r1,iAdrszMessErreur
    bl   displayError
    mov r0,#1
    b 100f

100:                           @ standard end of the program
    mov r7, #EXIT
    svc 0
iFenetreMask:        .int  KeyPressMask|ButtonPressMask|StructureNotifyMask
iGris1:              .int 0xFFA0A0A0
iAdrWhite:           .int iWhite
iAdrBlack:           .int iBlack
iAdrptDisplay:       .int ptDisplay
iAdrptEcranDef:      .int ptEcranDef
iAdrptFenetre:       .int ptFenetre
iAdrptGC:            .int ptGC
iAdrptGC1:           .int ptGC1
iAdrevent:           .int event
iAdrbuffer:          .int buffer
iAdrkey:             .int key
iAdrszLibDW:         .int szLibDW
iAdrszMessDebutPgm:  .int szMessDebutPgm
iAdrszMessErreurX11: .int szMessErreurX11
iAdrszMessErrGc:     .int szMessErrGc
iAdrszMessErreur:    .int szMessErreur
iAdrszMessErrfen:    .int szMessErrfen
iAdrszWindowName:    .int szWindowName
iAdrszTitreFenRed:   .int szTitreFenRed
iAdrszTexte1:            .int szTexte1
iAdrszTexte2:        .int szTexte2
iAdrPrpNomFenetre:   .int PrpNomFenetre
iAdrwmDeleteMessage: .int wmDeleteMessage

/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {r0,r1,r2,r7,lr}                   @ save  registres
    mov r2,#0                               @ counter length
1:                                          @ loop length calculation
    ldrb r1,[r0,r2]                         @ read octet start position + index
    cmp r1,#0                               @ if 0 its over
    addne r2,r2,#1                          @ else add 1 in the length
    bne 1b                                  @ and loop
                                            @ so here r2 contains the length of the message
    mov r1,r0                               @ address message in r1
    mov r0,#STDOUT                          @ code to write to the standard output Linux
    mov r7, #WRITE                          @ code call system "write"
    svc #0                                  @ call systeme
    pop {r0,r1,r2,r7,lr}                    @ restaur registers
    bx lr                                   @ return
/***************************************************/
/*   display error message                         */
/***************************************************/
/* r0 contains error code  r1 : message address */
displayError:
    push {r0-r2,lr}                         @ save registers
    mov r2,r0                               @ save error code
    mov r0,r1
    bl affichageMess
    mov r0,r2                               @ error code
    ldr r1,iAdrsHexa
    bl conversion16                         @ conversion hexa
    mov r0,r2                               @ error code
    ldr r1,iAdrsDeci                        @ result address
    bl conversion10                         @ conversion decimale
    ldr r0,iAdrszMessErr                    @ display error message
    bl affichageMess
100:
    pop {r0-r2,lr}                          @ restaur registers
    bx lr                                   @ return
iAdrszMessErr:                 .int szMessErr
iAdrsHexa:                     .int sHexa
iAdrsDeci:                     .int sDeci
/******************************************************************/
/*     Converting a register to hexadecimal                      */
/******************************************************************/
/* r0 contains value and r1 address area   */
conversion16:
    push {r1-r4,lr}                                    @ save registers
    mov r2,#28                                         @ start bit position
    mov r4,#0xF0000000                                 @ mask
    mov r3,r0                                          @ save entry value
1:                                                     @ start loop
    and r0,r3,r4                                       @value register and mask
    lsr r0,r2                                          @ move right
    cmp r0,#10                                         @ compare value
    addlt r0,#48                                       @ <10  ->digit
    addge r0,#55                                       @ >10  ->letter A-F
    strb r0,[r1],#1                                    @ store digit on area and + 1 in area address
    lsr r4,#4                                          @ shift mask 4 positions
    subs r2,#4                                         @  counter bits - 4 <= zero  ?
    bge 1b                                             @  no -> loop

100:
    pop {r1-r4,lr}                                     @ restaur registers
    bx lr                                              @return
/******************************************************************/
/*     Converting a register to a decimal unsigned                */
/******************************************************************/
/* r0 contains value and r1 address area   */
/* r0 return size of result (no zero final in area) */
/* area size => 11 bytes          */
.equ LGZONECAL,   10
conversion10:
    push {r1-r4,lr}                                 @ save registers
    mov r3,r1
    mov r2,#LGZONECAL
1:                                                  @ start loop
    bl divisionpar10U                               @ unsigned  r0 <- dividende. quotient ->r0 reste -> r1
    add r1,#48                                      @ digit
    strb r1,[r3,r2]                                 @ store digit on area
    cmp r0,#0                                       @ stop if quotient = 0
    subne r2,#1                                     @ else previous position
    bne 1b                                          @ and loop
                                                    @ and move digit from left of area
    mov r4,#0
2:
    ldrb r1,[r3,r2]
    strb r1,[r3,r4]
    add r2,#1
    add r4,#1
    cmp r2,#LGZONECAL
    ble 2b
                                                      @ and move spaces in end on area
    mov r0,r4                                         @ result length
    mov r1,#' '                                       @ space
3:
    strb r1,[r3,r4]                                   @ store space in area
    add r4,#1                                         @ next position
    cmp r4,#LGZONECAL
    ble 3b                                            @ loop if r4 <= area size

100:
    pop {r1-r4,lr}                                    @ restaur registres
    bx lr                                             @return

/***************************************************/
/*   division par 10   unsigned                    */
/***************************************************/
/* r0 dividende   */
/* r0 quotient    */
/* r1 remainder   */
divisionpar10U:
    push {r2,r3,r4, lr}
    mov r4,r0                                          @ save value
    ldr r3,iMagicNumber                                @ r3 <- magic_number    raspberry 1 2
    umull r1, r2, r3, r0                               @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
    mov r0, r2, LSR #3                                 @ r2 <- r2 >> shift 3
    add r2,r0,r0, lsl #2                               @ r2 <- r0 * 5
    sub r1,r4,r2, lsl #1                               @ r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10)
    pop {r2,r3,r4,lr}
    bx lr                                              @ leave function
iMagicNumber:  	.int 0xCCCCCCCD
/***************************************************/
/* integer division unsigned                       */
/***************************************************/
division:
    /* r0 contains dividend */
    /* r1 contains divisor */
    /* r2 returns quotient */
    /* r3 returns remainder */
    push {r4, lr}
    mov r2, #0                                         @ init quotient
    mov r3, #0                                         @ init remainder
    mov r4, #32                                        @ init counter bits
    b 2f
1:                                                    @ loop
    movs r0, r0, LSL #1                               @ r0 <- r0 << 1 updating cpsr (sets C if 31st bit of r0 was 1)
    adc r3, r3, r3                                     @ r3 <- r3 + r3 + C. This is equivalent to r3 ? (r3 << 1) + C
    cmp r3, r1                                         @ compute r3 - r1 and update cpsr
    subhs r3, r3, r1                                  @ if r3 >= r1 (C=1) then r3 <- r3 - r1
    adc r2, r2, r2                                     @ r2 <- r2 + r2 + C. This is equivalent to r2 <- (r2 << 1) + C
2:
    subs r4, r4, #1                                   @ r4 <- r4 - 1
    bpl 1b                                            @ if r4 >= 0 (N=0) then loop
    pop {r4, lr}
    bx lr


Gui, Add, Picture, x100 y100 w2 h2 +0x4E +HWNDhPicture
CreatePixel("FF0000", hPicture)
Gui, Show, w320 h240, Example
return

CreatePixel(Color, Handle) {
	VarSetCapacity(BMBITS, 4, 0), Numput("0x" . Color, &BMBITS, 0, "UInt")
	hBM := DllCall("Gdi32.dll\CreateBitmap", "Int", 1, "Int", 1, "UInt", 1, "UInt", 24, "Ptr", 0, "Ptr")
	hBM := DllCall("User32.dll\CopyImage", "Ptr", hBM, "UInt", 0, "Int", 0, "Int", 0, "UInt", 0x2008, "Ptr")
	DllCall("Gdi32.dll\SetBitmapBits", "Ptr", hBM, "UInt", 3, "Ptr", &BMBITS)
	DllCall("User32.dll\SendMessage", "Ptr", Handle, "UInt", 0x172, "Ptr", 0, "Ptr", hBM)
}


rem http://rosettacode.org/wiki/Draw_a_pixel

graphsize 320, 240
color red
plot 100, 100


#include<graphics.h>

int main()
{
	initwindow(320,240,"Red Pixel");

	putpixel(100,100,RED);

	getch();

	return 0;
}


10 COLOR 0,0,2,2: REM BLACK BACKGROUND AND BORDER, RED TEXT AND EXTRA COLOR
20 GRAPHIC 2:SCNCLR:REM SELECT HI-RES GRAPHICS AND CLEAR THE SCREEN
30 POINT 2,640,640:REM DRAW A POINT AT 640/1024*160,640/1024*160
40 GET K$:IF K$="" THEN 40: REM WAIT FOR KEYPRESS
50 GRAPHIC 0:REM BACK TO TEXT MODE


program Draw_a_pixel;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Windows,
  Messages,
  SysUtils;

var
  Msg: TMSG;
  LWndClass: TWndClass;
  hMainHandle: HWND;

procedure Paint(Handle: hWnd); forward;

procedure ReleaseResources;
begin
  PostQuitMessage(0);
end;

function WindowProc(hWnd, Msg: Longint; wParam: wParam; lParam: lParam): Longint; stdcall;
begin
  case Msg of
    WM_PAINT:
      Paint(hWnd);
    WM_DESTROY:
      ReleaseResources;
  end;
  Result := DefWindowProc(hWnd, Msg, wParam, lParam);
end;

procedure CreateWin(W, H: Integer);
begin
  LWndClass.hInstance := hInstance;
  with LWndClass do
  begin
    lpszClassName := 'OneRedPixel';
    Style := CS_PARENTDC or CS_BYTEALIGNCLIENT;
    hIcon := LoadIcon(hInstance, 'MAINICON');
    lpfnWndProc := @WindowProc;
    hbrBackground := COLOR_BTNFACE + 1;
    hCursor := LoadCursor(0, IDC_ARROW);
  end;

  RegisterClass(LWndClass);
  hMainHandle := CreateWindow(LWndClass.lpszClassName,
    'Draw a red pixel on (100,100)', WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU
    or WS_VISIBLE, ((GetSystemMetrics(SM_CXSCREEN) - W) div 2), ((GetSystemMetrics
    (SM_CYSCREEN) - H) div 2), W, H, 0, 0, hInstance, nil);
end;

procedure ShowModal;
begin
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;

procedure Paint(Handle: hWnd);
var
  ps: PAINTSTRUCT;
  Dc: HDC;
begin
  Dc := BeginPaint(Handle, ps);

  // Fill bg with white
  FillRect(Dc, ps.rcPaint, CreateSolidBrush($FFFFFF));

  // Do the magic
  SetPixel(Dc, 100, 100, $FF);

  EndPaint(Handle, ps);
end;

begin
  CreateWin(320, 240);
  ShowModal();
end.


open System.Windows.Forms
open System.Drawing

let f = new Form()
f.Size <- new Size(320,240)
f.Paint.Add(fun e -> e.Graphics.FillRectangle(Brushes.Red, 100, 100 ,1,1))
Application.Run(f)


USING: accessors arrays images images.testing images.viewer
kernel literals math sequences ;
IN: rosetta-code.draw-pixel

: draw-pixel ( -- )
    B{ 255 0 0 } 100 100 <rgb-image> 320 240 [ 2array >>dim ]
    [ * ] 2bi [ { 0 0 0 } ] replicate B{ } concat-as >>bitmap
    [ set-pixel-at ] keep image-window ;

MAIN: draw-pixel


\ Bindings to SDL2 functions
s" SDL2" add-lib
\c #include <SDL2/SDL.h>
c-function sdl-init		SDL_Init		n -- n
c-function sdl-quit		SDL_Quit		-- void
c-function sdl-createwindow	SDL_CreateWindow	a n n n n n -- a
c-function sdl-createrenderer	SDL_CreateRenderer	a n n -- a
c-function sdl-setdrawcolor	SDL_SetRenderDrawColor	a n n n n -- n
c-function sdl-drawpoint	SDL_RenderDrawPoint	a n n -- n
c-function sdl-renderpresent	SDL_RenderPresent	a -- void
c-function sdl-delay            SDL_Delay               n -- void

: pixel ( -- )
  $20 sdl-init drop
  s\" Rosetta Task : Draw a pixel\x0" drop 0 0 320 240 $0 sdl-createwindow
  ( window ) -1 $2 sdl-createrenderer

  dup ( renderer ) 255 0 0 255 sdl-setdrawcolor drop
  dup ( renderer ) 100 100 sdl-drawpoint drop
      ( renderer ) sdl-renderpresent

  5000 sdl-delay
  sdl-quit
;

pixel


' version 27-06-2018
' compile with: fbc -s console
'           or: fbc -s gui

Screen 13                  ' Screen 18: 320x200,  8bit colordepth
'ScreenRes 320, 200, 24    ' Screenres: 320x200, 24bit colordepth

If ScreenPtr = 0 Then
    Print "Error setting video mode!"
    End
End If

Dim As UInteger depth, x = 100, y = 100

' what is color depth
ScreenInfo ,,depth

If depth = 8 Then
    PSet(x, y), 40   ' palette, index 40 = RGB(255, 0, 0)
Else
    PSet(x, y), RGB(255, 0, 0) ' red
End If

' empty keyboard buffer
While Inkey <> "" : Wend
WindowTitle IIf(depth = 8, "Palette","True Color") + ", hit any key to end program"
Sleep
End


package main

import (
    "fmt"
    "image"
    "image/color"
    "image/draw"
)

func main() {
    rect := image.Rect(0, 0, 320, 240)
    img := image.NewRGBA(rect)

    // Use green background, say.
    green := color.RGBA{0, 255, 0, 255}
    draw.Draw(img, rect, &image.Uniform{green}, image.ZP, draw.Src)

    // Set color of pixel at (100, 100) to red
    red := color.RGBA{255, 0, 0, 255}
    img.Set(100, 100, red)

    // Check it worked.
    cmap := map[color.Color]string{green: "green", red: "red"}
    c1 := img.At(0, 0)
    c2 := img.At(100, 100)
    fmt.Println("The color of the pixel at (  0,   0) is", cmap[c1], "\b.")
    fmt.Println("The color of the pixel at (100, 100) is", cmap[c2], "\b.")
}


#
# draw-pixel.icn
#
procedure main()
   &window := open("pixel", "g", "size=320,240")
   Fg("#ff0000")
   DrawPoint(100, 100)
   Event()
end


100 SET VIDEO X 40:SET VIDEO Y 26:SET VIDEO MODE 5:SET VIDEO COLOR 0
110 OPEN #101:"video:"
120 DISPLAY #101:AT 1 FROM 1 TO 26
130 SET PALETTE BLACK,RED
140 PLOT 100,100


require 'gl2'
coinsert 'jgl2'
wd'pc Rosetta closeok;cc task isidraw; set task wh 320 200;pshow'
glpaint glpixel 100 100 [ glpen 1 1 [ glrgb 255 0 0 [ glclear ''


import java.awt.Color;
import java.awt.Graphics;
import javax.swing.JFrame;

public class DrawAPixel extends JFrame{
	public DrawAPixel() {
		super("Red Pixel");
		setSize(320, 240);
		setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
		setVisible(true);
	}
	@Override
	public void paint(Graphics g) {
		g.setColor(new Color(255, 0, 0));
		g.drawRect(100, 100, 1, 1);
	}
	public static void main(String[] args) {
		new DrawAPixel();
	}
}


using Gtk, Graphics

const can = @GtkCanvas()
const win = GtkWindow(can, "Draw a Pixel", 320, 240)

draw(can) do widget
    ctx = getgc(can)
    set_source_rgb(ctx, 255, 0, 0)
    move_to(ctx, 100, 100)
    line_to(ctx, 101,100)
    stroke(ctx)
end

show(can)
const cond = Condition()
endit(w) = notify(cond)
signal_connect(endit, win, :destroy)
wait(cond)


// Version 1.2.41

import java.awt.Color
import java.awt.Graphics
import java.awt.image.BufferedImage

class BasicBitmapStorage(width: Int, height: Int) {
    val image = BufferedImage(width, height, BufferedImage.TYPE_3BYTE_BGR)

    fun fill(c: Color) {
        val g = image.graphics
        g.color = c
        g.fillRect(0, 0, image.width, image.height)
    }

    fun setPixel(x: Int, y: Int, c: Color) = image.setRGB(x, y, c.getRGB())

    fun getPixel(x: Int, y: Int) = Color(image.getRGB(x, y))
}

fun main(args: Array<String>) {
    val bbs = BasicBitmapStorage(320, 240)
    with (bbs) {
        fill(Color.white) // say
        setPixel(100, 100, Color.red)
        // check it worked
        val c = getPixel(100, 100)
        print("The color of the pixel at (100, 100) is ")
        println(if (c == Color.red) "red" else "white")
    }
}


1) html/css

{div {@ style="position:relative;
               left:0; top:0; width:320px; height:240px;
               border:1px solid #000;"}
 {div {@ style="position:absolute; left:100px; top:100px;
                width:1px; height:1px; background:#f00; border:0;"}}}

2) svg

{svg {@ width="320" height="240"
        style="border:1px solid #000;"}
  {rect {@ x="100" y="100" width="1" height="1"
           style="fill:#f00; stroke-width:0; stroke:#f00;"}}}

3) canvas

{canvas {@ id="canvas" width="320" height="240"
           style="border:1px solid #000;"}}

{script
  var canvas_pixel = function(x, y, canvas) {
    var ctx = document.getElementById( canvas )
                      .getContext( "2d" );
    ctx.fillStyle = "#f00";
    ctx.fillRect(x,y,1,1);
  };

  setTimeout( canvas_pixel, 1, 100, 100, "canvas" )
}


local SDL = require "SDL"

local ret = SDL.init { SDL.flags.Video }
local window = SDL.createWindow {
	title	= "Pixel",
	height	= 320,
	width	= 240
}

local renderer = SDL.createRenderer(window, 0, 0)

renderer:clear()
renderer:setDrawColor(0xFF0000)
renderer:drawPoint({x = 100,y = 100})
renderer:present()

SDL.delay(5000)


CreateWindow[PaletteNotebook[{Graphics[{Red, Point[{100, 100}]}]}], WindowSize -> {320, 240}]


Module CheckIt {
      Module PlotPixel (a as single, b as single) {
            Move a*TwipsX, b*TwipsX
            Draw TwipsX, TwipsY
      }
      Cls 5,0  \\ clear console with Magenta (5) and set split  screen from 0 (no split screen)
      Pen #55FF77 {
            PlotPixel 1000, 200
      }
      Wait 1000
      Title "", 1
      Declare DrawPixelForm Form
      With DrawPixelForm, "Title", "Draw a Pixel at 100,100"
      Layer DrawPixelForm {
            \\ 12 for 12pt fonts
            \\ use ; to center window
            Window 12, 320*twipsx, 240*twipsy;
            Cls #333333
            Pen Color(255,0,0) {
                  PlotPixel 100, 100
            }
      }
      \\ code to show/hide console clicking form
      \\ console shown behind form
      k=0
      Function DrawPixelForm.Click {
            Title "Rosetta Code Example", abs(k)
            if k then show
            k~
      }
      Method DrawPixelForm, "Show", 1
      Declare DrawPixelForm Nothing
}
CheckIt


import rapid/gfx

var
  window = initRWindow()
    .size(320, 240)
    .title("Rosetta Code - draw a pixel")
    .open()
  surface = window.openGfx()

surface.loop:
  draw ctx, step:
    ctx.clear(gray(0))
    ctx.begin()
    ctx.point((100.0, 100.0, rgb(255, 0, 0)))
    ctx.draw(prPoints)
    discard step # Prevent unused variable warnings
  update step:
    discard step


MODULE pixel;

	IMPORT XYplane;

BEGIN
	XYplane.Open;
	XYplane.Dot(100, 100, XYplane.draw);
	REPEAT UNTIL XYplane.Key() = "q"
END pixel.


use Game.SDL2;
use Game.Framework;

class DrawPixel {
  @framework : GameFramework;

  function : Main(args : String[]) ~ Nil {
    DrawPixel->New()->Run();
  }

  New() {
    @framework := GameFramework->New(320, 240, "RGB");
    @framework->SetClearColor(Color->New(0, 0, 0));
  }

  method : Run() ~ Nil {
    if(@framework->IsOk()) {
      e := @framework->GetEvent();

      quit := false;
      while(<>quit) {
        @framework->FrameStart();
        @framework->Clear();

        while(e->Poll() <> 0) {
          if(e->GetType() = EventType->SDL_QUIT) {
            quit := true;
          };
        };

        @framework->GetRenderer()->SetDrawColor(255, 0, 0, 255);
        @framework->GetRenderer()->DrawPoint(100, 100);

        @framework->Show();
        @framework->FrameEnd();
      };
    }
    else {
      "--- Error Initializing Game Environment ---"->ErrorLine();
      return;
    };

    leaving {
      @framework->Quit();
    };
  }
}


module G = Graphics

let () =
  G.open_graph "";
  G.resize_window 320 240;
  G.set_color G.red;
  G.plot 100 100;
  ignore (G.read_key ())


(import (lib gl))
(import (OpenGL version-1-0))

; init
(glClearColor 0.3 0.3 0.3 1)
(glOrtho 0 320 0 240 0 1)

; draw loop
(gl:set-renderer (lambda (mouse)
   (glClear GL_COLOR_BUFFER_BIT)
   (glBegin GL_POINTS)
   (glColor3f 255 0 0)
   (glVertex2f 100 100)
   (glEnd)))


use Gtk3 '-init';

my $window = Gtk3::Window->new();
$window->set_default_size(320, 240);
$window->set_border_width(10);
$window->set_title("Draw a Pixel");
$window->set_app_paintable(TRUE);

my $da = Gtk3::DrawingArea->new();
$da->signal_connect('draw' => \&draw_in_drawingarea);
$window->add($da);
$window->show_all();

Gtk3->main;

sub draw_in_drawingarea
{
  my ($widget, $cr, $data) = @_;
  $cr->set_source_rgb(1, 0, 0);
  $cr->set_line_width(1);
  $cr->rectangle( 100, 100, 1, 1);
  $cr->stroke;
}


with javascript_semantics
include pGUI.e

cdCanvas cdcanvas

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
    cdCanvasActivate(cdcanvas)
    cdCanvasPixel(cdcanvas, 100, 100, CD_RED)
    cdCanvasFlush(cdcanvas)
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    return IUP_DEFAULT
end function

procedure main()
    IupOpen()
    Ihandle canvas = IupCanvas(NULL)
    IupSetAttribute(canvas, "RASTERSIZE", "320x240")
    IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
    Ihandle dlg = IupDialog(canvas)
    IupSetAttribute(dlg, "TITLE", "Draw a pixel")
    IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
    IupShow(dlg)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


  If OpenWindow(0, 0, 0, 320, 240, "Rosetta Code Draw A Pixel in PureBasic")
    If CreateImage(0, 320, 240) And StartDrawing(ImageOutput(0))
          Plot(100, 100,RGB(255,0,0))
      StopDrawing()
      ImageGadget(0, 0, 0, 320, 240, ImageID(0))
    EndIf
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
  EndIf


from PIL import Image

img = Image.new('RGB', (320, 240))
pixels = img.load()
pixels[100,100] = (255,0,0)
img.show()


' http://rosettacode.org/wiki/Draw_a_pixel
' This program can run in QBASIC, QuickBASIC, gw-BASIC (adding line numbers) and VB-DOS
SCREEN 1
COLOR , 0
PSET (100, 100), 2
END


#lang racket
(require racket/draw)
(let ((b (make-object bitmap% 320 240)))
  (send b set-argb-pixels 100 100 1 1 (bytes 255 0 0 255))
  b)


use GTK::Simple;
use GTK::Simple::DrawingArea;
use Cairo;

my $app = GTK::Simple::App.new(:title('Draw a Pixel'));
my $da  = GTK::Simple::DrawingArea.new;
gtk_simple_use_cairo;

$app.set-content( $da );
$app.border-width = 5;
$da.size-request(320,240);

sub rect-do( $d, $ctx ) {
    given $ctx {
        .rgb(1, 0, 0);
        .rectangle(100, 100, 1, 1);
        .fill;
    }
}

my $ctx = $da.add-draw-handler( &rect-do );
$app.run;


type document  // abstract type for a document object
type context = { mutable fillStyle: string, }

@val external doc: document = "document"

@send external getElementById: (document, string) => Dom.element = "getElementById"
@send external getContext: (Dom.element, string) => context = "getContext"

@send external fillRect: (context, int, int, int, int) => unit = "fillRect"

let canvas = getElementById(doc, "my_canvas")
let ctx = getContext(canvas, "2d")

ctx.fillStyle = "#F00"
fillRect(ctx, 100, 100, 1, 1)


/*REXX program displays (draws) a pixel at a specified screen location in the color red.*/
parse upper version !ver .
!pcrexx= 'REXX/PERSONAL'==!ver | 'REXX/PC'==!ver /*obtain the REXX interpreter version. */
parse arg x y txt CC .                           /*obtain optional arguments from the CL*/
if   x=='' |  x==","  then   x= 100              /*Not specified?  Then use the default.*/
if   y=='' |  y==","  then   y= 100              /* "       "        "   "   "     "    */
if  CC=='' |  CC=","  then  CC=   4              /* "       "        "   "   "     "    */
if txt=='' | txt=","  then tzt= '·'              /* "       "        "   "   "     "    */

if ¬!pcrexx  then do; say; say "***error***  PC/REXX[interpreter] isn't being used.";  say
                      exit 23
                  end

call scrWrite x,y,txt,,,CC                       /*stick a fork in it,  we're all done. */


# Project  : Draw a pixel

load "guilib.ring"

new qapp {
       win1 = new qwidget() {
                  setwindowtitle("Drawing Pixels")
                  setgeometry(100,100,320,240)
                  label1 = new qlabel(win1) {
                              setgeometry(10,10,300,200)
                              settext("")
                  }
                  new qpushbutton(win1) {
                         setgeometry(200,200,100,30)
                         settext("draw")
                         setclickevent("draw()")
                  }
                  show()
       }
       exec()
}

func draw()
        p1 = new qpicture()
        color = new qcolor() {
                   setrgb(255,0,0,255)
                  }
        pen = new qpen() {
                  setcolor(color)
                  setwidth(5)
                  }
        new qpainter() {
               begin(p1)
               setpen(pen)
               drawpoint(100,100)
               endpaint()
               }
               label1 { setpicture(p1) show() }


. "Set the sprite's reference character located at the"
. "upper-left corner of the board (char 0)"
set "SPR0_REFX" to 0
set "SPR0_REFY" to 0

. "Offset that reference by 256, leading to the first character"
. "in the extended character set"
set "SPR0_OFFSET" to 256

. "Set the width and height of the sprite"
set "SPR0_WIDTH" to 1
set "SPR0_HEIGHT" to 1

. "Unbound the sprite, removing the grid restriction"
set "SPR0_UNBOUND" to 1

. "Mark the sprite for display on the overlay (this may not be necessary)"
set "SPR0_OVERLAY" to 1

set "xPos" to 100
set "yPos" to 100

. "Display the sprite at the given location"
put c0c Sprite p00 at "('xPos')" "('yPos')"


require 'gtk3'

Width, Height = 320, 240
PosX, PosY = 100, 100

window = Gtk::Window.new
window.set_default_size(Width, Height)
window.title = 'Draw a pixel'

window.signal_connect(:draw) do |widget, context|
  context.set_antialias(Cairo::Antialias::NONE)
  # paint out bg with white
  # context.set_source_rgb(1.0, 1.0, 1.0)
  # context.paint(1.0)
  # draw a rectangle
  context.set_source_rgb(1.0, 0.0, 0.0)
  context.fill do
    context.rectangle(PosX, PosY, 1, 1)
  end
end

window.signal_connect(:destroy) { Gtk.main_quit }

window.show
Gtk.main


extern crate piston_window;
extern crate image;

use piston_window::*;

fn main() {
    let (width, height) = (320, 240);

    let mut window: PistonWindow =
        WindowSettings::new("Red Pixel", [width, height])
        .exit_on_esc(true).build().unwrap();

    // Since we cant manipulate pixels directly, we need to manipulate the pixels on a canvas.
    // Only issue is that sub-pixels exist (which is probably why the red pixel looks like a smear on the output image)
    let mut canvas = image::ImageBuffer::new(width, height);
    canvas.put_pixel(100, 100, image::Rgba([0xff, 0, 0, 0xff]));

    // Transform into a texture so piston can use it.
    let texture: G2dTexture = Texture::from_image(
        &mut window.factory,
        &canvas,
        &TextureSettings::new()
    ).unwrap();

    // The window event loop.
    while let Some(event) = window.next() {
        window.draw_2d(&event, |context, graphics| {
            clear([1.0; 4], graphics);
            image(&texture,
            context.transform,
            graphics);
        });
    }
}


import java.awt.image.BufferedImage
import java.awt.Color
import scala.language.reflectiveCalls

object RgbBitmap extends App {

  class RgbBitmap(val dim: (Int, Int)) {
    def width = dim._1
    def height = dim._2

    private val image = new BufferedImage(width, height, BufferedImage.TYPE_3BYTE_BGR)

    def apply(x: Int, y: Int) = new Color(image.getRGB(x, y))

    def update(x: Int, y: Int, c: Color) = image.setRGB(x, y, c.getRGB)

    def fill(c: Color) = {
      val g = image.getGraphics
      g.setColor(c)
      g.fillRect(0, 0, width, height)
    }
  }

  object RgbBitmap {
    def apply(width: Int, height: Int) = new RgbBitmap(width, height)
  }

  /** Even Javanese style testing is still possible.
    */
  private val img0 = new RgbBitmap(50, 60) { // Wrappers to enable adhoc Javanese style
    def getPixel(x: Int, y: Int) = this(x, y)
    def setPixel(x: Int, y: Int, c: Color) = this(x, y) = c
  }

  img0.fill(Color.CYAN)
  img0.setPixel(5, 6, Color.BLUE)
  // Testing in Java style
  assert(img0.getPixel(0, 1) == Color.CYAN)
  assert(img0.getPixel(5, 6) == Color.BLUE)
  assert(img0.width == 50)
  assert(img0.height == 60)
  println("Tests successfully completed with no errors found.")

}


XSCREEN 3
DISPLAY 1
GPSET 100, 100, RGB(255, 0, 0)
WAIT 60


open XWindows ;
open Motif ;

val imgWindow = fn () =>

 let
  val shell  =  XtAppInitialise      ""    "demo" "top" [] [ XmNwidth 320, XmNheight 240 ] ;
  val main   =  XmCreateMainWindow   shell    "main"       [ XmNmappedWhenManaged true ]   ;
  val canvas =  XmCreateDrawingArea  main   "drawarea"     [ XmNwidth 320, XmNheight 240 ] ;
  val usegc  =  DefaultGC (XtDisplay canvas) ;
  val put    =  fn (w,s,t) => ( XSetForeground usegc 0xff0000 ;
                                XDrawPoint (XtWindow canvas) usegc ( XPoint {x=100,y=100} ) ; t);
in

  (
   XtSetCallbacks   canvas [ (XmNexposeCallback , put) ] XmNarmCallback ;
   XtManageChild    canvas ;
   XtManageChild    main ;
   XtRealizeWidget  shell
  )

end;


package require Tcl 8.5
package require Tk

pack [canvas .c -width 320 -height 240 -bg #fff] -anchor nw
.c create rectangle 100 100 100 100 -fill #f00 -outline ""


SET WINDOW 0, 320, 0, 240
SET COLOR 4
PLOT 100,100
END


Sub draw()
    Dim sh As Shape, sl As Shape
    Set sh = ActiveDocument.Shapes.AddCanvas(100, 100, 320, 240)
    Set sl = sh.CanvasItems.AddLine(100, 100, 101, 100)
    sl.Line.ForeColor.RGB = RGB(Red:=255, Green:=0, Blue:=0)
End Sub


import gg
import gx

fn main() {
    mut context := gg.new_context(
        width: 320
        height: 240
        frame_fn: frame
    )
    context.run()
}

fn frame(mut ctx gg.Context) {
    ctx.begin()
    ctx.draw_pixel(100, 100, gx.red)
    ctx.end()
}


import "dome" for Window
import "graphics" for Canvas, Color

class Game {
    static init() {
        Window.title = "Draw a pixel"
        Window.resize(320, 240)
        Canvas.resize(320, 240)
        var red = Color.rgb(255, 0, 0)
        Canvas.pset(100, 100, red)
        // check it worked
        var col = Canvas.pget(100, 100)
        System.print("The color of the pixel at (100, 100) is %(getRGB(col))")
    }

    static update() {}

    static draw(dt) {}

    static getRGB(col) { "{%(col.r), %(col.g), %(col.b)}" }
}


        .model  tiny
        .code
        org     100h

start:  mov     ax, 0013h       ;set 320x200x8 graphic screen
        int     10h
        push    0A000h          ;point to graphic memory segment
        pop     es
        mov     byte ptr es:[320*100+100], 28h  ;draw bright red pixel

        mov     ah, 0           ;wait for keystroke
        int     16h
        mov     ax, 0003h       ;restore normal text mode screen
        int     10h
        ret                     ;return to OS
        end     start


procedure Insert (Anchor : Link_Access; New_Link : Link_Access) is
begin
   if Anchor /= Null and New_Link /= Null then
      New_Link.Next := Anchor.Next;
      New_Link.Prev := Anchor;
      if New_Link.Next /= Null then
         New_Link.Next.Prev := New_Link;
      end if;
      Anchor.Next := New_Link;
   end if;
end Insert;


#!/usr/local/bin/a68g --script #

# SEMA do link OF splice = LEVEL 1 #
MODE LINK = STRUCT (
  REF LINK prev,
  REF LINK next,
  DATA value
);

# BEGIN rosettacode task specimen code:
  can handle insert both before the first, and after the last link #

PROC insert after = (REF LINK #self,# prev, DATA new data)LINK: (
# DOWN do link OF splice OF self; to make thread safe #
  REF LINK next = next OF prev;
  HEAP LINK new link := LINK(prev, next, new data);
  next OF prev := prev OF next := new link;
# UP do link OF splice OF self; #
  new link
);

PROC insert before = (REF LINK #self,# next, DATA new data)LINK:
  insert after(#self,# prev OF next, new data);

# END rosettacode task specimen code #

# Test case: #
MODE DATA = STRUCT(INT year elected, STRING name);
FORMAT data fmt = $dddd": "g"; "$;

test:(

# manually initialise the back splices #
  LINK presidential splice;
  presidential splice := (presidential splice, presidential splice, SKIP);

# manually build the chain #
  LINK previous, incumbent, elect;
  previous := (presidential splice, incumbent,          DATA(1993, "Clinton"));
  incumbent:= (previous,           elect,              DATA(2001, "Bush"   ));
  elect    := (incumbent,          presidential splice, DATA(2008, "Obama"  ));

  insert after(incumbent, LOC DATA := DATA(2004, "Cheney"));

  REF LINK node := previous;
  WHILE REF LINK(node) ISNT presidential splice DO
    printf((data fmt, value OF node));
    node := next OF node
  OD;
  print(new line)
)


    % record type to hold an element of a doubly linked list of integers      %
    record DListIElement ( reference(DListIElement) prev
                         ; integer iValue
                         ; reference(DListIElement) next
                         );
    % additional record types would be required for other element types       %
    % inserts a new element into the list, before e                           %
    reference(DListIElement) procedure insertIntoDListIBefore( reference(DListIElement) value e
                                                             ; integer                  value v
                                                             );
    begin
        reference(DListIElement) newElement;
        newElement := DListIElement( null, v, e );
        if e not = null then begin
            % the element we are inserting before is not null                 %
            reference(DListIElement) ePrev;
            ePrev            := prev(e);
            prev(newElement) := ePrev;
            prev(e)          := newElement;
            if ePrev not = null then next(ePrev) := newElement
        end if_e_ne_null ;
        newElement
    end insertIntoDListiAfter ;


Lbl INSERT
{r₁+2}ʳ→{r₂+2}ʳ
r₁→{r₂+4}ʳ
r₂→{{r₂+2}ʳ+4}ʳ
r₂→{r₁+2}ʳ
r₁
Return


      DIM node{pPrev%, pNext%, iData%}
      DIM a{} = node{}, b{} = node{}, c{} = node{}

      a.pNext% = b{}
      a.iData% = 123
      b.pPrev% = a{}
      b.iData% = 456
      c.iData% = 789

      PROCinsert(a{}, c{})
      END

      DEF PROCinsert(here{}, new{})
      LOCAL temp{} : DIM temp{} = node{}
      new.pNext% = here.pNext%
      new.pPrev% = here{}
      !(^temp{}+4) = new.pNext%
      temp.pPrev% = new{}
      here.pNext% = new{}
      ENDPROC


void insert(link* anchor, link* newlink) {
  newlink->next = anchor->next;
  newlink->prev = anchor;
  (newlink->next)->prev = newlink;
  anchor->next = newlink;
}


static void InsertAfter(Link prev, int i)
{
    if (prev.next != null)
    {
        prev.next.prev = new Link() { item = i, prev = prev, next = prev.next };
        prev.next = prev.next.prev;
    }
    else
        prev.next = new Link() { item = i, prev = prev };
}


template <typename T>
void insert_after(Node<T>* N, T&& data)
{
    auto node = new Node<T>{N, N->next, std::forward(data)};
    if(N->next != nullptr)
        N->next->prev = node;
    N->next = node;
}


(defrecord Node [prev next data])

(defn new-node [prev next data]
  (Node. (ref prev) (ref next) data))

(defn new-list [head tail]
  (List. (ref head) (ref tail)))

(defn insert-between [node1 node2 new-node]
  (dosync
   (ref-set (:next node1) new-node)
   (ref-set (:prev new-node) node1)
   (ref-set (:next new-node) node2)
   (ref-set (:prev node2) new-node)))

(set! *print-level* 1)

;; warning: depending on the value of *print-level*
;;   this could cause a stack overflow when printing

(let [h (new-node nil nil :A)
      t (new-node nil nil :B)]
  (insert-between h t (new-node nil nil :C))
  (new-list h t))


import std.stdio;

struct Node(T) {
    T data;
    typeof(this)* prev, next;
}

/// If prev is null, prev gets to point to a new node.
void insertAfter(T)(ref Node!T* prev, T item) pure nothrow {
    if (prev) {
        auto newNode = new Node!T(item, prev, prev.next);
        prev.next = newNode;
        if (newNode.next)
            newNode.next.prev = newNode;
    } else
        prev = new Node!T(item);
}

void show(T)(Node!T* list) {
    while (list) {
        write(list.data, " ");
        list = list.next;
    }
    writeln;
}

void main() {
    Node!(string)* list;
    insertAfter(list, "A");
    list.show;
    insertAfter(list, "B");
    list.show;
    insertAfter(list, "C");
    list.show;
}


program Element_insertion;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,Boost.LinkedList;

var
 List:TLinkedList<Integer>;
 Node:TLinkedListNode<Integer>;
begin
  List := TLinkedList<Integer>.Create;
  Node:= List.Add(5);
  List.AddAfter(Node,7);
  List.AddAfter(Node,15);
  Writeln(List.ToString);
  List.Free;
  Readln;
end.


def insert(after, value) {
    def newNode := makeElement(value, after, after.getNext())
    after.getNext().setPrev(newNode)
    after.setNext(newNode)
}


2> doubly_linked_list:task().
foreach_next a
foreach_next c
foreach_next b
foreach_previous b
foreach_previous c
foreach_previous a


module dlList
    public :: node, insertAfter, getNext

    type node
        real :: data
        type( node ), pointer :: next => null()
        type( node ), pointer :: previous => null()
    end type node

contains
    subroutine insertAfter(nodeBefore, value)
        type( node ), intent(inout), target :: nodeBefore
        type( node ), pointer :: newNode
        real, intent(in) :: value

        allocate( newNode )
        newNode%data = value
        newNode%next => nodeBefore%next
        newNode%previous => nodeBefore

        if (associated( newNode%next )) then
            newNode%next%previous => newNode
        end if
        newNode%previous%next => newNode
    end subroutine insertAfter

    subroutine delete(current)
        type( node ), intent(inout), pointer :: current

        if (associated( current%next )) current%next%previous => current%previous
        if (associated( current%previous )) current%previous%next => current%next
        deallocate(current)
    end subroutine delete
end module dlList

program dlListTest
    use dlList
    type( node ), target :: head
    type( node ), pointer :: current, next

    head%data = 1.0
    current => head
    do i = 1, 20
       call insertAfter(current, 2.0**i)
       current => current%next
    end do

    current => head
    do while (associated(current))
        print *, current%data
        next => current%next
        if (.not. associated(current, head)) call delete(current)
        current => next
    end do
end program dlListTest


#define FIL    1
#define DATO   2
#define LPREV  3
#define LNEXT  4

Dim Shared As Integer countNodes, Nodes
countNodes = 0
Nodes = 10

Dim Shared As Integer list(Nodes, 4)
list(0, LNEXT) = 1

Function searchNode(node As Integer) As Integer
    Dim As Integer Node11

    For i As Integer = 0 To node-1
        Node11 = list(Node11, LNEXT)
    Next i
    Return Node11
End Function

Sub insertNode(node As Integer, newNode As Integer)
    Dim As Integer Node11, i

    If countNodes = 0 Then node = 2

    For i = 1 To Nodes
        If Not list(i, FIL) Then Exit For
    Next
    list(i, FIL) = True
    list(i, DATO) = newNode

    Node11 = searchNode(node)

    list(i, LPREV) = list(Node11, LPREV)
    list(list(i, LPREV), LNEXT) = i
    If i <> Node11 Then list(i, LNEXT) = Node11 : list(Node11, LPREV) = i

    countNodes += 1
    If countNodes = Nodes Then Nodes += 10 : Redim list(Nodes, 4)
End Sub

Sub removeNode(n As Integer)
    Dim As Integer Node11 = searchNode(n)
    list(list(Node11, LPREV), LNEXT) = list(Node11, LNEXT)
    list(list(Node11, LNEXT), LPREV) = list(Node11, LPREV)
    list(Node11, LNEXT) = 0
    list(Node11, LPREV) = 0
    list(Node11, FIL) = False
    countNodes -= 1
End Sub

Sub printNode(node As Integer)
    Dim As Integer Node11 = searchNode(node)
    Print list(Node11, DATO);
    Print
End Sub

Sub traverseList()
    For i As Integer = 1 To countNodes
        printNode(i)
    Next i
End Sub

insertNode(1, 1000)
insertNode(2, 2000)
insertNode(2, 3000)

traverseList()

removeNode(2)

Print
traverseList()
Sleep


package main

import "fmt"

type dlNode struct {
    string
    next, prev *dlNode
}

type dlList struct {
    head, tail *dlNode
}

func (list *dlList) String() string {
    if list.head == nil {
        return fmt.Sprint(list.head)
    }
    r := "[" + list.head.string
    for p := list.head.next; p != nil; p = p.next {
        r += " " + p.string
    }
    return r + "]"
}

func (list *dlList) insertTail(node *dlNode) {
    if list.tail == nil {
        list.head = node
    } else {
        list.tail.next = node
    }
    node.next = nil
    node.prev = list.tail
    list.tail = node
}

func (list *dlList) insertAfter(existing, insert *dlNode) {
    insert.prev = existing
    insert.next = existing.next
    existing.next.prev = insert
    existing.next = insert
    if existing == list.tail {
        list.tail = insert
    }
}

func main() {
    dll := &dlList{}
    fmt.Println(dll)
    a := &dlNode{string: "A"}
    dll.insertTail(a)
    dll.insertTail(&dlNode{string: "B"})
    fmt.Println(dll)
    dll.insertAfter(a, &dlNode{string: "C"})
    fmt.Println(dll)
}


insert _  Leaf            = Leaf
insert nv l@(Node pl v r) = (\(Node c _ _) -> c) new
    where new   = updateLeft left . updateRight right $ Node l nv r
          left  = Node pl v new
          right = case r of
                      Leaf       -> Leaf
                      Node _ v r -> Node new v r


class DoubleLink (value, prev_link, next_link)

  # insert given node after this one, losing its existing connections
  method insert_after (node)
    node.prev_link := self
    if (\next_link) then next_link.prev_link := node
    node.next_link := next_link
    self.next_link := node
  end

  initially (value, prev_link, next_link)
    self.value := value
    self.prev_link := prev_link    # links are 'null' if not given
    self.next_link := next_link
end


import java.util.LinkedList;

@SuppressWarnings("serial")
public class DoublyLinkedListInsertion<T> extends LinkedList<T> {

    public static void main(String[] args) {
        DoublyLinkedListInsertion<String> list = new DoublyLinkedListInsertion<String>();
        list.addFirst("Add First 1");
        list.addFirst("Add First 2");
        list.addFirst("Add First 3");
        list.addFirst("Add First 4");
        list.addFirst("Add First 5");
        traverseList(list);

        list.addAfter("Add First 3", "Add New");
        traverseList(list);
    }

    /*
     * Add after indicated node.  If not in the list, added as the last node.
     */
    public void addAfter(T after, T element) {
        int index = indexOf(after);
        if ( index >= 0 ) {
            add(index + 1, element);
        }
        else {
            addLast(element);
        }
    }

    private static void traverseList(LinkedList<String> list) {
        System.out.println("Traverse List:");
        for ( int i = 0 ; i < list.size() ; i++ ) {
            System.out.printf("Element number %d - Element value = '%s'%n", i, list.get(i));
        }
        System.out.println();
    }

}


DoublyLinkedList.prototype.insertAfter = function(searchValue, nodeToInsert) {
    if (this._value == searchValue) {
        var after = this.next();
        this.next(nodeToInsert);
        nodeToInsert.prev(this);
        nodeToInsert.next(after);
        after.prev(nodeToInsert);
    }
    else if (this.next() == null)
        throw new Error(0, "value '" + searchValue + "' not found in linked list.")
    else
        this.next().insertAfter(searchValue, nodeToInsert);
}

var list = createDoublyLinkedListFromArray(['A','B']);
list.insertAfter('A', new DoublyLinkedList('C', null, null));


mutable struct DLNode{T}
    value::T
    pred::Union{DLNode{T}, Nothing}
    succ::Union{DLNode{T}, Nothing}
    DLNode(v) = new{typeof(v)}(v, nothing, nothing)
end

function insertpost(prevnode, node)
    succ = prevnode.succ
    prevnode.succ = node
    node.pred = prevnode
    node.succ = succ
    if succ != nothing
        succ.pred =  node
    end
    node
end

function printfromroot(root)
    print(root.value)
    while root.succ != nothing
        root = root.succ
        print(" -> $(root.value)")
    end
    println()
end

node1 = DLNode(1)
printfromroot(node1)
node2 = DLNode(2)
node3 = DLNode(3)
insertpost(node1, node2)
printfromroot(node1)
insertpost(node1, node3)
printfromroot(node1)


// version 1.1.2

class Node<T: Number>(var data: T, var prev: Node<T>? = null, var next: Node<T>? = null) {
    override fun toString(): String {
        val sb = StringBuilder(this.data.toString())
        var node = this.next
        while (node != null) {
            sb.append(" -> ", node.data.toString())
            node = node.next
        }
        return sb.toString()
    }
}

fun <T: Number> insert(after: Node<T>, new: Node<T>) {
    new.next = after.next
    if (after.next != null) after.next!!.prev = new
    new.prev = after
    after.next = new
}

fun main(args: Array<String>) {
    val a = Node(1)
    val b = Node(3, a)
    a.next = b
    println("Before insertion : $a")
    val c = Node(2)
    insert(after = a, new = c)
    println("After  insertion : $a")
}


ds = CreateDataStructure["DoublyLinkedList"];
ds["Append", "A"];
ds["Append", "B"];
ds["Append", "C"];
ds["SwapPart", 2, 3];
ds["Elements"]


proc insertAfter[T](l: var List[T], r, n: Node[T]) =
  n.prev = r
  n.next = r.next
  n.next.prev = n
  r.next = n
  if r == l.tail: l.tail = n


        PROCEDURE (dll: DLList) InsertAfter*(p: Node; o: Box.Object);
	VAR
		n: Node;
	BEGIN
		n := NewNode(o);
		n.prev := p;
		n.next := p.next;
		IF p.next # NIL THEN p.next.prev := n END;
		p.next := n;
		IF p = dll.last THEN dll.last := n END;
		INC(dll.size)
	END InsertAfter;


method : public : native : AddBack(value : Base) ~ Nil {
  node := ListNode->New(value);
  if(@head = Nil) {
    @head := node;
    @tail := @head;
  }
  else {
    @tail->SetNext(node);
    node->SetPrevious(@tail);
    @tail := node;
  };
}


(* val _insert : 'a dlink -> 'a dlink -> unit *)
let _insert anchor newlink =
  newlink.next <- anchor.next;
  newlink.prev <- Some anchor;
  begin match newlink.next with
  | None -> ()
  | Some next ->
      next.prev <-Some newlink;
  end;
  anchor.next <- Some newlink;;

(* val insert : 'a dlink option -> 'a -> unit *)
let insert dl v =
  match dl with
  | (Some anchor) -> _insert anchor {data=v; prev=None; next=None}
  | None  -> invalid_arg "dlink empty";;


: test      // ( -- aDList )
| dl |
   DList new ->dl
   dl insertFront("A")
   dl insertBack("B")
   dl head insertAfter(DNode new("C", null , null))
   dl ;


declare
  fun {CreateNewNode Value}
     node(prev:{NewCell nil}
          next:{NewCell nil}
          value:Value)
  end

  proc {InsertAfter Node NewNode}
     Next = Node.next
  in
     (NewNode.next) := @Next
     (NewNode.prev) := Node
     case @Next of nil then skip
     [] node(prev:NextPrev ...) then
        NextPrev := NewNode
     end
     Next := NewNode
  end

  A = {CreateNewNode a}
  B = {CreateNewNode b}
  C = {CreateNewNode c}
in
  {InsertAfter A B}
  {InsertAfter A C}


procedure insert_link( a, b, c: link_ptr );
begin
  a^.next := c;
  if b <> nil then b^.prev := c;
  c^.next := b;
  c^.prev := a;
end;


my %node_model = (
        data => 'something',
        prev => undef,
        next => undef,
);

sub insert
{
        my ($anchor, $newlink) = @_;
        $newlink->{next} = $anchor->{next};
        $newlink->{prev} = $anchor;
        $newlink->{next}->{prev} = $newlink;
        $anchor->{next} = $newlink;
}

# create the list {A,B}
my $node_a = { %node_model };
my $node_b = { %node_model };

$node_a->{next} = $node_b;
$node_b->{prev} = $node_a;

# insert element C into a list {A,B}, between elements A and B.
my $node_c = { %node_model };
insert($node_a, $node_c);


enum NEXT,PREV,DATA
constant empty_dll = {{1,1}}
sequence dll = deep_copy(empty_dll)

procedure insert_after(object data, integer pos=1)
    integer prv = dll[pos][PREV]
    dll = append(dll,{pos,prv,data})
    if prv!=0 then
        dll[prv][NEXT] = length(dll)
    end if
    dll[pos][PREV] = length(dll)
end procedure

insert_after("ONE")
insert_after("TWO")
insert_after("THREE")

?dll


# Insert an element X at position Pos
(de 2insert (X Pos DLst)
   (let (Lst (nth (car DLst) (dec (* 2 Pos)))  New (cons X (cadr Lst) Lst))
      (if (cadr Lst)
         (con (cdr @) New)
         (set DLst New) )
      (if (cdr Lst)
         (set @ New)
         (con DLst New) ) ) )

(setq *DL (2list 'A 'B))      # Build a two-element doubly-linked list
(2insert 'C 2 *DL)            # Insert C at position 2


define structure
   1 Node,
      2 value        fixed decimal,
      2 back_pointer handle(Node),
      2 fwd_pointer  handle(Node);

/* Given that 'Current" points at some node in the linked list :    */

P = NEW (: Node :); /* Create a node. */
get (P => value);
P => fwd_pointer = Current => fwd_pointer;
                    /* Points the new node at the next one.         */
Current => fwd_pinter = P;
                    /* Points the current node at the new one.      */
P => back_pointer = Current;
                    /* Points the new node back at the current one. */
Q = P => fwd_pointer;
Q => back_pointer = P;
                    /* Points the next node to the new one.         */


define insert_double(list, element);
   lvars tmp;
   if list == [] then
      ;;; Insertion into empty list, return element
      element
   else
      next(list) -> tmp;
      list -> prev(element);
      tmp -> next(element);
      element -> next(list);
      if tmp /= [] then
         element -> prev(tmp)
      endif;
      ;;; return original list
      list
   endif;
enddefine;

lvars A = newLink(), B = newLink(), C = newLink();
;;; Build the list of A and B
insert_double(A, B) -> _;
;;; insert C between A and b
insert_double(A, C) -> _;


Structure node
  *prev.node
  *next.node
  value.c ;use character type for elements in this example
EndStructure

Procedure insertAfter(element.c, *c.node)
  ;insert new node *n after node *c and set it's value to element
  Protected *n.node = AllocateMemory(SizeOf(node))
  If *n
    *n\value = element
    *n\prev = *c
    If *c
      *n\next = *c\next
      *c\next = *n
    EndIf
  EndIf
  ProcedureReturn *n
EndProcedure

Procedure displayList(*dl.node)
  Protected *n.node = *dl
  Repeat
    Print(Chr(*n\Value) + " ")
    *n = *n\next
  Until *n = #Null
EndProcedure

If OpenConsole()
  Define dl.node, *n.node

  *n = insertAfter('A',dl)
  insertAfter('B',*n)
  insertAfter('C',*n)

  displayList(dl)

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
EndIf


def insert(anchor, new):
    new.next = anchor.next
    new.prev = anchor
    anchor.next.prev = new
    anchor.next = new


role DLElem[::T] {
    has DLElem[T] $.prev is rw;
    has DLElem[T] $.next is rw;
    has T $.payload = T;

    method pre-insert(T $payload) {
        die "Can't insert before beginning" unless $!prev;
        my $elem = ::?CLASS.new(:$payload);
        $!prev.next = $elem;
        $elem.prev = $!prev;
        $elem.next = self;
        $!prev = $elem;
        $elem;
    }

    method post-insert(T $payload) {
        die "Can't insert after end" unless $!next;
        my $elem = ::?CLASS.new(:$payload);
        $!next.prev = $elem;
        $elem.next = $!next;
        $elem.prev = self;
        $!next = $elem;
        $elem;
    }

    method delete {
        die "Can't delete a sentinel" unless $!prev and $!next;
        $!next.prev = $!prev;
        $!prev.next = $!next;   # conveniently returns next element
    }
}

role DLList[::DLE] {
    has DLE $.first;
    has DLE $.last;

    submethod BUILD {
	$!first = DLE.new;
	$!last = DLE.new;
	$!first.next = $!last;
	$!last.prev = $!first;
    }

    method list { ($!first.next, *.next ...^ !*.next).map: *.payload }
    method reverse { ($!last.prev, *.prev ...^ !*.prev).map: *.payload }
}

class DLElem_Str does DLElem[Str] {}
class DLList_Str does DLList[DLElem_Str] {}

my $sdll = DLList_Str.new;
my $b = $sdll.first.post-insert('A').post-insert('B');
$b.pre-insert('C');
say $sdll.list;  # A C B


/*REXX program that implements various   List Manager   functions.      */
/*┌────────────────────────────────────────────────────────────────────┐
┌─┘                    Functions of the  List Manager                  └─┐
│                                                                        │
│ @init      ─── initializes the List.                                   │
│                                                                        │
│ @size      ─── returns the size of the List  [could be  0  (zero)].    │
│                                                                        │
│ @show      ─── shows (displays) the complete List.                     │
│ @show k,1  ─── shows (displays) the  Kth  item.                        │
│ @show k,m  ─── shows (displays)   M  items,  starting with  Kth  item. │
│ @show ,,─1 ─── shows (displays) the complete List backwards.           │
│                                                                        │
│ @get  k    ─── returns the  Kth  item.                                 │
│ @get  k,m  ─── returns the  M  items  starting with the  Kth  item.    │
│                                                                        │
│ @put  x    ─── adds the  X  items to the  end  (tail) of the List.     │
│ @put  x,0  ─── adds the  X  items to the start (head) of the List.     │
│ @put  x,k  ─── adds the  X  items to before of the  Kth  item.         │
│                                                                        │
│ @del  k    ─── deletes the item  K.                                    │
│ @del  k,m  ─── deletes the   M  items  starting with item  K.          │
└─┐                                                                    ┌─┘
  └────────────────────────────────────────────────────────────────────┘*/
call sy 'initializing the list.'           ; call @init
call sy 'building list: Was it a cat I saw'; call @put 'Was it a cat I saw'
call sy 'displaying list size.'            ; say 'list size='@size()
call sy 'forward list'                     ; call @show
call sy 'backward list'                    ; call @show ,,-1
call sy 'showing 4th item'                 ; call @show 4,1
call sy 'showing 6th & 6th items'          ; call @show 5,2
call sy 'adding item before item 4: black' ; call @put 'black',4
call sy 'showing list'                     ; call @show
call sy 'adding to tail: there, in the ...'; call @put 'there, in the shadows, stalking its prey (and next meal).'
call sy 'showing list'                     ; call @show
call sy 'adding to head: Oy!'              ; call @put  'Oy!',0
call sy 'showing list'                     ; call @show
exit                                   /*stick a fork in it, we're done.*/
/*──────────────────────────────────subroutines─────────────────────────*/
p:       return word(arg(1),1)
sy:      say; say left('',30) "───" arg(1) '───'; return
@hasopt: arg o; return pos(o,opt)\==0
@size:   return $.#
@init:   $.@=''; $.#=0; return 0
@adjust: $.@=space($.@); $.#=words($.@); return 0

@parms:  arg opt
         if @hasopt('k') then k=min($.#+1,max(1,p(k 1)))
         if @hasopt('m') then m=p(m 1)
         if @hasopt('d') then dir=p(dir 1)
         return

@show:   procedure expose $.;   parse arg k,m,dir
         if dir==-1 & k=='' then k=$.#
         m=p(m $.#);
         call @parms 'kmd'
         say @get(k,m,dir);
         return 0

@get:    procedure expose $.;   arg k,m,dir,_
         call @parms 'kmd'
                             do j=k for m by dir while j>0 & j<=$.#
                             _=_ subword($.@,j,1)
                             end   /*j*/
         return strip(_)

@put:    procedure expose $.;   parse arg x,k
         k=p(k $.#+1)
         call @parms 'k'
         $.@=subword($.@,1,max(0,k-1)) x subword($.@,k)
         call @adjust
         return 0

@del:    procedure expose $.;   arg k,m
         call @parms 'km'
         _=subword($.@,k,k-1) subword($.@,k+m)
         $.@=_
         call @adjust
         return


class DListNode
  def insert_after(search_value, new_value)
    if search_value == value
      new_node = self.class.new(new_value, nil, nil)
      next_node = self.succ
      self.succ = new_node
      new_node.prev = self
      new_node.succ = next_node
      next_node.prev = new_node
    elsif self.succ.nil?
      raise StandardError, "value #{search_value} not found in list"
    else
      self.succ.insert_after(search_value, new_value)
    end
  end
end

head = DListNode.from_array([:a, :b])
head.insert_after(:a, :c)


use std::collections::LinkedList;
fn main() {
    let mut list = LinkedList::new();
    list.push_front(8);
}


typealias NodePtr<T> = UnsafeMutablePointer<Node<T>>

class Node<T> {
  var value: T
  fileprivate var prev: NodePtr<T>?
  fileprivate var next: NodePtr<T>?

  init(value: T, prev: NodePtr<T>? = nil, next: NodePtr<T>? = nil) {
    self.value = value
    self.prev = prev
    self.next = next
  }
}

@discardableResult
func insert<T>(_ val: T, after: Node<T>? = nil, list: NodePtr<T>? = nil) -> NodePtr<T> {
  let node = NodePtr<T>.allocate(capacity: 1)

  node.initialize(to: Node(value: val))

  var n = list

  while n != nil {
    if n?.pointee !== after {
      n = n?.pointee.next

      continue
    }

    node.pointee.prev = n
    node.pointee.next = n?.pointee.next
    n?.pointee.next?.pointee.prev = node
    n?.pointee.next = node

    break
  }

  return node
}

// [1]
let list = insert(1)

// [1, 2]
insert(2, after: list.pointee, list: list)

// [1, 3, 2]
insert(3, after: list.pointee, list: list)


oo::define List {
    method insertBefore {elem} {
        $elem next [self]
        $elem previous $prev
        if {$prev ne ""} {
            $prev next $elem
        }
        set prev $elem
    }
    method insertAfter {elem} {
        $elem previous [self]
        $elem next $next
        if {$next ne ""} {
            $next previous $elem
        }
        set next $elem
    }
}


Public Sub Insert(ByVal a As Node(Of T), ByVal b As Node(Of T), ByVal c As T)
    Dim node As New Node(Of T)(value)
    a.Next = node
    node.Previous = a
    b.Previous = node
    node.Next = b
End Sub


import "/llist" for DLinkedList

var dll = DLinkedList.new(["A", "B"])
dll.insertAfter("A", "C")
System.print(dll)


// Rosetta Code problem: http://rosettacode.org/wiki/Doubly-linked_list/Element_insertion & removal & traverse
// by Galileo, 02/2022

FIL = 1 : DATO = 2 : LPREV = 3 : LNEXT = 4
countNodes = 0 : Nodes = 10

dim list(Nodes, 4)

list(0, LNEXT) = 1

sub searchNode(node)
    local i, Node

    for i = 0 to node-1
        Node = list(Node, LNEXT)
    next
    return Node
end sub

sub insertNode(node, newNode)
    local Node, i

    if not countNodes node = 2

    for i = 1 to Nodes
        if not list(i, FIL) break
    next
    list(i, FIL) = true
    list(i, DATO) = newNode

    Node = searchNode(node)

    list(i, LPREV) = list(Node, LPREV) : list(list(i, LPREV), LNEXT) = i
    if i <> Node list(i, LNEXT) = Node : list(Node, LPREV) = i

    countNodes = countNodes + 1
    if countNodes = Nodes then Nodes = Nodes + 10 : redim list(Nodes, 4) : end if
end sub

sub removeNode(n)
    local Node

    Node = searchNode(n)
    list(list(Node, LPREV), LNEXT) = list(Node, LNEXT)
    list(list(Node, LNEXT), LPREV) = list(Node, LPREV)
    list(Node, LNEXT) = 0 : list(Node, LPREV) = 0
    list(Node, FIL) = false
    countNodes = countNodes - 1
end sub

sub printNode(node)
    local Node

    Node = searchNode(node)
    print list(Node, DATO);
    print
end sub

sub traverseList()
    local i

    for i = 1 to countNodes
        printNode(i)
    next
end sub

insertNode(1, 1000)
insertNode(2, 2000)
insertNode(2, 3000)

traverseList()

removeNode(2)

print
traverseList()


class Node{
   fcn init(_value,_prev=Void,_next=Void)
      { var value=_value, prev=_prev, next=_next; }
   fcn toString{ value.toString() }
   fcn append(value){
      b,c := Node(value,self,next),next;
      next=b;
      if(c) c.prev=b;
      b
   }
}


with Ada.Numerics.Elementary_Functions;

with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Events.Events;

procedure Rotating_Cube is

   Width  : constant := 500;
   Height : constant := 500;
   Offset : constant := 500.0 / 2.0;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;
   Event    : SDL.Events.Events.Events;
   Quit     : Boolean := False;

   type Node_Id   is new Natural;
   type Point_3D  is record X, Y, Z : Float;   end record;
   type Edge_Type is record A, B    : Node_Id; end record;

   Nodes : array (Node_Id range <>) of Point_3D :=
     ((-100.0, -100.0, -100.0), (-100.0, -100.0, 100.0), (-100.0, 100.0, -100.0),
      (-100.0, 100.0, 100.0),   (100.0, -100.0, -100.0), (100.0, -100.0, 100.0),
      (100.0, 100.0, -100.0),   (100.0, 100.0, 100.0));
   Edges : constant array (Positive range <>) of Edge_Type :=
     ((0, 1), (1, 3), (3, 2), (2, 0), (4, 5), (5, 7),
      (7, 6), (6, 4), (0, 4), (1, 5), (2, 6), (3, 7));

   use Ada.Numerics.Elementary_Functions;

   procedure Rotate_Cube (AngleX, AngleY : in Float) is
      SinX : constant Float := Sin (AngleX);
      CosX : constant Float := Cos (AngleX);
      SinY : constant Float := Sin (AngleY);
      CosY : constant Float := Cos (AngleY);
      X, Y, Z : Float;
   begin
      for Node of Nodes loop
         X := Node.X;
         Y := Node.Y;
         Z := Node.Z;
         Node.X := X * CosX - Z * SinX;
         Node.Z := Z * CosX + X * SinX;
         Z := Node.Z;
         Node.Y := Y * CosY - Z * SinY;
         Node.Z := Z * CosY + Y * SinY;
      end loop;
   end Rotate_Cube;

   function Poll_Quit return Boolean is
      use type SDL.Events.Event_Types;
   begin
      while SDL.Events.Events.Poll (Event) loop
         if Event.Common.Event_Type = SDL.Events.Quit then
            return True;
         end if;
      end loop;
      return False;
   end Poll_Quit;

   procedure Draw_Cube (Quit : out Boolean) is
      use SDL.C;
      Pi : constant := Ada.Numerics.Pi;
      Xy1, Xy2 : Point_3D;
   begin
      Rotate_Cube (Pi / 4.0, Arctan (Sqrt (2.0)));
      for Frame in 0 .. 359 loop
         Renderer.Set_Draw_Colour ((0, 0, 0, 255));
         Renderer.Fill (Rectangle => (0, 0, Width, Height));

         Renderer.Set_Draw_Colour ((0, 220, 0, 255));
         for Edge of Edges loop
            Xy1 := Nodes (Edge.A);
            Xy2 := Nodes (Edge.B);
            Renderer.Draw (Line => ((int (Xy1.X + Offset), int (Xy1.Y + Offset)),
                                    (int (Xy2.X + Offset), int (Xy2.Y + Offset))));
         end loop;
         Rotate_Cube (Pi / 180.0, 0.0);
         Window.Update_Surface;
         Quit := Poll_Quit;
         exit when Quit;
         delay 0.020;
      end loop;
   end Draw_Cube;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Rotating cube",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);

   while not Quit loop
      Draw_Cube (Quit);
   end loop;

   Window.Finalize;
   SDL.Finalise;
end Rotating_Cube;


; ---------------------------------------------------------------
cubeSize	:= 200
deltaX		:= A_ScreenWidth/2
deltaY		:= A_ScreenHeight/2
keyStep		:= 1
mouseStep	:= 0.2
zoomStep	:= 1.1
playSpeed	:= 1
playTimer	:= 10
penSize		:= 5

/*
HotKeys:
!p::			Play/Stop
!x::			change play to x-axis
!y::			change play to y-axis
!z::			change play to z-axis
!NumpadAdd::	Zoom in
!WheelUp::		Zoom in
!NumpadSub::	Zoom out
!WheelDown::	Zoom out
!LButton::		Rotate X-axis, follow mouse
!Up::			Rotate X-axis, CCW
!Down::			Rotate X-axis, CW
!LButton::		Rotate Y-axis, follow mouse
!Right::		Rotate Y-axis, CCW
!Left::			Rotate Y-axis, CW
!RButton::		Rotate Z-axis, follow mouse
!PGUP::			Rotate Z-axis, CW
!PGDN::			Rotate Z-axis, CCW
+LButton::		Move, follow mouse
^esc::			Exitapp
*/
visualCube =
(
			1+--------+5
			 |\         \
			 | 2+--------+6
			 |  |        |
			3+  |   7+   |
			  \ |        |
			   4+--------+8
)

SetBatchLines, -1
coord := cubeSize/2
nodes	:=[[-coord, -coord, -coord]
		,  [-coord, -coord,  coord]
		,  [-coord,  coord, -coord]
		,  [-coord,  coord,  coord]
		,  [ coord, -coord, -coord]
		,  [ coord, -coord,  coord]
		,  [ coord,  coord, -coord]
		,  [ coord,  coord,  coord]]

edges	:= [[1, 2], [2, 4], [4, 3], [3, 1]
		,   [5, 6], [6, 8], [8, 7], [7, 5]
		,   [1, 5], [2, 6], [3, 7], [4, 8]]

faces 	:= [[1,2,4,3], [2,4,8,6], [1,2,6,5], [1,3,7,5], [5,7,8,6], [3,4,8,7]]

CP := [(nodes[8,1]+nodes[1,1])/2 , (nodes[8,2]+nodes[1,2])/2]

rotateX3D(-30)
rotateY3D(30)
Gdip1()
draw()
return

; --------------------------------------------------------------
draw() {
	global
	D := ""
	for i, n in nodes
		D .= Sqrt((n.1-CP.1)**2 + (n.2-CP.2)**2) "`t:" i ":`t" n.3 "`n"
	Sort, D, N
	p1 := StrSplit(StrSplit(D, "`n", "`r").1, ":").2
	p2 := StrSplit(StrSplit(D, "`n", "`r").2, ":").2
	hiddenNode := nodes[p1,3] < nodes[p2,3] ? p1 : p2

	; Draw Faces
	loop % faces.count() {
		n1 := faces[A_Index, 1]
		n2 := faces[A_Index, 2]
		n3 := faces[A_Index, 3]
		n4 := faces[A_Index, 4]
		if (n1 = hiddenNode) || (n2 = hiddenNode) || (n3 = hiddenNode) || (n4 = hiddenNode)
			continue
		points := nodes[n1,1]+deltaX "," nodes[n1,2]+deltaY
			. "|" nodes[n2,1]+deltaX "," nodes[n2,2]+deltaY
			. "|" nodes[n3,1]+deltaX "," nodes[n3,2]+deltaY
			. "|" nodes[n4,1]+deltaX "," nodes[n4,2]+deltaY
		Gdip_FillPolygon(G, FaceBrush%A_Index%, Points)
	}

	; Draw Node-Numbers
	;~ loop % nodes.count() {
		;~ Gdip_FillEllipse(G, pBrush, nodes[A_Index, 1]+deltaX, nodes[A_Index, 2]+deltaY, 4, 4)
		;~ Options := "x" nodes[A_Index, 1]+deltaX " y" nodes[A_Index, 2]+deltaY "c" TextColor " Bold s" size
		;~ Gdip_TextToGraphics(G, A_Index, Options, Font)
	;~ }

	; Draw Edges
	loop % edges.count() {
		n1 := edges[A_Index, 1]
		n2 := edges[A_Index, 2]
		if (n1 = hiddenNode) || (n2 = hiddenNode)
			continue
		Gdip_DrawLine(G, pPen, nodes[n1,1]+deltaX, nodes[n1,2]+deltaY, nodes[n2,1]+deltaX, nodes[n2,2]+deltaY)
	}
	UpdateLayeredWindow(hwnd1, hdc, 0, 0, Width, Height)
}

; ---------------------------------------------------------------
rotateZ3D(theta) { ; Rotate shape around the z-axis
	global
	theta *= 3.141592653589793/180
	sinTheta := sin(theta)
	cosTheta := cos(theta)
	loop % nodes.count() {
		x := nodes[A_Index,1]
		y := nodes[A_Index,2]
		nodes[A_Index,1] := x*cosTheta - y*sinTheta
		nodes[A_Index,2] := y*cosTheta + x*sinTheta
	}
	Redraw()
}

; ---------------------------------------------------------------
rotateX3D(theta) { ; Rotate shape around the x-axis
	global
	theta *= 3.141592653589793/180
	sinTheta := sin(theta)
	cosTheta := cos(theta)
	loop % nodes.count() {
		y := nodes[A_Index, 2]
		z := nodes[A_Index, 3]
		nodes[A_Index, 2] := y*cosTheta - z*sinTheta
		nodes[A_Index, 3] := z*cosTheta + y*sinTheta
	}
	Redraw()
}

; ---------------------------------------------------------------
rotateY3D(theta) { ; Rotate shape around the y-axis
	global
	theta *= 3.141592653589793/180
	sinTheta := sin(theta)
	cosTheta := cos(theta)
	loop % nodes.count() {
		x := nodes[A_Index, 1]
		z := nodes[A_Index, 3]
		nodes[A_Index, 1] := x*cosTheta + z*sinTheta
		nodes[A_Index, 3] := z*cosTheta - x*sinTheta
	}
	Redraw()
}

; ---------------------------------------------------------------
Redraw(){
	global
	gdip2()
	gdip1()
	draw()
}

; ---------------------------------------------------------------
gdip1(){
	global
	If !pToken := Gdip_Startup()
	{
		MsgBox, 48, gdiplus error!, Gdiplus failed to start. Please ensure you have gdiplus on your system
		ExitApp
	}
	OnExit, Exit
	Width := A_ScreenWidth, Height := A_ScreenHeight
	Gui, 1: -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop
	Gui, 1: Show, NA
	hwnd1 := WinExist()
	hbm := CreateDIBSection(Width, Height)
	hdc := CreateCompatibleDC()
	obm := SelectObject(hdc, hbm)
	G := Gdip_GraphicsFromHDC(hdc)
	Gdip_SetSmoothingMode(G, 4)
	TextColor:="FFFFFF00", size := 18
	Font := "Arial"
	Gdip_FontFamilyCreate(Font)
	pBrush := Gdip_BrushCreateSolid(0xFFFF00FF)
	FaceBrush1 := Gdip_BrushCreateSolid(0xFF0000FF)	; blue
	FaceBrush2 := Gdip_BrushCreateSolid(0xFFFF0000) ; red
	FaceBrush3 := Gdip_BrushCreateSolid(0xFFFFFF00) ; yellow
	FaceBrush4 := Gdip_BrushCreateSolid(0xFFFF7518) ; orange
	FaceBrush5 := Gdip_BrushCreateSolid(0xFF00FF00) ; lime
	FaceBrush6 := Gdip_BrushCreateSolid(0xFFFFFFFF) ; white
	pPen := Gdip_CreatePen(0xFF000000, penSize)
}

; ---------------------------------------------------------------
gdip2(){
	global
	Gdip_DeleteBrush(pBrush)
	Gdip_DeletePen(pPen)
	SelectObject(hdc, obm)
	DeleteObject(hbm)
	DeleteDC(hdc)
	Gdip_DeleteGraphics(G)
}
; Viewing Hotkeys ----------------------------------------------
; HotKey Play/Stop ---------------------------------------------
!p::
SetTimer, rotateTimer, % (toggle:=!toggle)?playTimer:"off"
return

rotateTimer:
axis := !axis ? "Y" : axis
rotate%axis%3D(playSpeed)
return

!x::
!y::
!z::
axis := SubStr(A_ThisHotkey, 2, 1)
return

; HotKey Zoom in/out -------------------------------------------
!NumpadAdd::
!NumpadSub::
!WheelUp::
!WheelDown::
loop % nodes.count()
{
	nodes[A_Index, 1] := nodes[A_Index, 1] * (InStr(A_ThisHotkey, "Add") || InStr(A_ThisHotkey, "Up") ? zoomStep : 1/zoomStep)
	nodes[A_Index, 2] := nodes[A_Index, 2] * (InStr(A_ThisHotkey, "Add") || InStr(A_ThisHotkey, "Up") ? zoomStep : 1/zoomStep)
	nodes[A_Index, 3] := nodes[A_Index, 3] * (InStr(A_ThisHotkey, "Add") || InStr(A_ThisHotkey, "Up") ? zoomStep : 1/zoomStep)
}
Redraw()
return

; HotKey Rotate around Y-Axis ----------------------------------
!Right::
!Left::
rotateY3D(keyStep * (InStr(A_ThisHotkey,"right") ? 1 : -1))
return

; HotKey Rotate around X-Axis ----------------------------------
!Up::
!Down::
rotateX3D(keyStep * (InStr(A_ThisHotkey, "Up") ? 1 : -1))
return

; HotKey Rotate around Z-Axis ----------------------------------
!PGUP::
!PGDN::
rotateZ3D(keyStep * (InStr(A_ThisHotkey, "UP") ? 1 : -1))
return

; HotKey, Rotate around X/Y-Axis -------------------------------
!LButton::
MouseGetPos, pmouseX, pmouseY
while GetKeyState("Lbutton", "P")
{
	MouseGetPos, mouseX, mouseY
	DeltaMX := mouseX - pmouseX
	DeltaMY := pmouseY - mouseY
	if (DeltaMX || DeltaMY)
	{
		MouseGetPos, pmouseX, pmouseY
		rotateY3D(DeltaMX)
		rotateX3D(DeltaMY)
	}
}
return

; HotKey Rotate around Z-Axis ----------------------------------
!RButton::
MouseGetPos, pmouseX, pmouseY
while GetKeyState("Rbutton", "P")
{
	MouseGetPos, mouseX, mouseY
	DeltaMX := mouseX - pmouseX
	DeltaMY := mouseY - pmouseY
	DeltaMX *= mouseY < deltaY ? mouseStep : -mouseStep
	DeltaMY *= mouseX > deltaX ? mouseStep : -mouseStep
	if (DeltaMX || DeltaMY)
	{
		MouseGetPos, pmouseX, pmouseY
		rotateZ3D(DeltaMX)
		rotateZ3D(DeltaMY)
	}
}
return

; HotKey, Move -------------------------------------------------
+LButton::
MouseGetPos, pmouseX, pmouseY
while GetKeyState("Lbutton", "P")
{
	MouseGetPos, mouseX, mouseY
	deltaX += mouseX - pmouseX
	deltaY += mouseY - pmouseY
	pmouseX := mouseX
	pmouseY := mouseY
	Redraw()
}
return

; ---------------------------------------------------------------
^esc::
Exit:
gdip2()
Gdip_Shutdown(pToken)
ExitApp
Return
; ---------------------------------------------------------------


global escala
global tam
global zoff
global cylr

escala = 50
tam = 320
zoff = 0.5773502691896257645091487805019574556
cylr = 1.6329931618554520654648560498039275946

clg
graphsize tam, tam

dim x(6)
theta = 0.0
dtheta = 1.5
dt = 1.0 / 30
dim cylphi = {PI/6, 5*PI/6, 3*PI/2, 11*PI/6, PI/2, 7*PI/6}

while key = ""
    lasttime = msec
    for i = 0 to 5
        x[i] = tam/2 + escala *cylr * cos(cylphi[i] + theta)
    next i
    clg
    call drawcube(x)

    while msec < lasttime + dt
    end while
    theta += dtheta*(msec-lasttime)
    pause .4
    call drawcube(x)
end while

subroutine drawcube(x)
    for i = 0 to 2
        color rgb(0,0,0)  #black
        line tam/2, tam/2 - escala / zoff, x[i], tam/2 - escala * zoff
        line tam/2, tam/2 + escala / zoff, x[5-i], tam/2 + escala * zoff
        line  x[i], tam/2 - escala * zoff, x[(i % 3) + 3], tam/2 + escala * zoff
        line  x[i], tam/2 - escala * zoff, x[((i+1)%3) + 3], tam/2 + escala * zoff
    next i
end subroutine


#include<gl/freeglut.h>

double rot = 0;
float matCol[] = {1,0,0,0};

void display(){
	glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT);
	glPushMatrix();
	glRotatef(30,1,1,0);
	glRotatef(rot,0,1,1);
	glMaterialfv(GL_FRONT,GL_DIFFUSE,matCol);
	glutWireCube(1);
	glPopMatrix();
	glFlush();
}

void onIdle(){
	rot += 0.1;
	glutPostRedisplay();
}

void reshape(int w,int h){
	float ar = (float) w / (float) h ;

	glViewport(0,0,(GLsizei)w,(GLsizei)h);
	glTranslatef(0,0,-10);
	glMatrixMode(GL_PROJECTION);
	gluPerspective(70,(GLfloat)w/(GLfloat)h,1,12);
	glLoadIdentity();
	glFrustum ( -1.0, 1.0, -1.0, 1.0, 10.0, 100.0 ) ;
	glMatrixMode(GL_MODELVIEW);
	glLoadIdentity();
}

void init(){
	float pos[] = {1,1,1,0};
	float white[] = {1,1,1,0};
	float shini[] = {70};

	glClearColor(.5,.5,.5,0);
	glShadeModel(GL_SMOOTH);
	glLightfv(GL_LIGHT0,GL_AMBIENT,white);
	glLightfv(GL_LIGHT0,GL_DIFFUSE,white);
	glMaterialfv(GL_FRONT,GL_SHININESS,shini);
	glEnable(GL_LIGHTING);
	glEnable(GL_LIGHT0);
	glEnable(GL_DEPTH_TEST);
}

int main(int argC, char* argV[])
{
	glutInit(&argC,argV);
	glutInitDisplayMode(GLUT_SINGLE|GLUT_RGB|GLUT_DEPTH);
	glutInitWindowSize(600,500);
	glutCreateWindow("Rossetta's Rotating Cube");
	init();
	glutDisplayFunc(display);
	glutReshapeFunc(reshape);
	glutIdleFunc(onIdle);
	glutMainLoop();
	return 0;
}


using System;
using System.Drawing;
using System.Drawing.Drawing2D;
using System.Windows.Forms;
using System.Windows.Threading;

namespace RotatingCube
{
    public partial class Form1 : Form
    {
        double[][] nodes = {
            new double[] {-1, -1, -1}, new double[] {-1, -1, 1}, new double[] {-1, 1, -1},
            new double[] {-1, 1, 1}, new double[] {1, -1, -1}, new double[] {1, -1, 1},
            new double[] {1, 1, -1}, new double[] {1, 1, 1} };

        int[][] edges = {
            new int[] {0, 1}, new int[] {1, 3}, new int[] {3, 2}, new int[] {2, 0}, new int[] {4, 5},
            new int[] {5, 7}, new int[] {7, 6}, new int[] {6, 4}, new int[] {0, 4}, new int[] {1, 5},
            new int[] {2, 6}, new int[] {3, 7}};

        public Form1()
        {
            Width = Height = 640;
            StartPosition = FormStartPosition.CenterScreen;
            SetStyle(
                ControlStyles.AllPaintingInWmPaint |
                ControlStyles.UserPaint |
                ControlStyles.DoubleBuffer,
                true);

            Scale(100, 100, 100);
            RotateCuboid(Math.PI / 4, Math.Atan(Math.Sqrt(2)));

            var timer = new DispatcherTimer();
            timer.Tick += (s, e) => { RotateCuboid(Math.PI / 180, 0); Refresh(); };
            timer.Interval = new TimeSpan(0, 0, 0, 0, 17);
            timer.Start();
        }

        private void RotateCuboid(double angleX, double angleY)
        {
            double sinX = Math.Sin(angleX);
            double cosX = Math.Cos(angleX);

            double sinY = Math.Sin(angleY);
            double cosY = Math.Cos(angleY);

            foreach (var node in nodes)
            {
                double x = node[0];
                double y = node[1];
                double z = node[2];

                node[0] = x * cosX - z * sinX;
                node[2] = z * cosX + x * sinX;

                z = node[2];

                node[1] = y * cosY - z * sinY;
                node[2] = z * cosY + y * sinY;
            }
        }

        private void Scale(int v1, int v2, int v3)
        {
            foreach (var item in nodes)
            {
                item[0] *= v1;
                item[1] *= v2;
                item[2] *= v3;
            }
        }

        protected override void OnPaint(PaintEventArgs args)
        {
            var g = args.Graphics;
            g.SmoothingMode = SmoothingMode.HighQuality;
            g.Clear(Color.White);

            g.TranslateTransform(Width / 2, Height / 2);

            foreach (var edge in edges)
            {
                double[] xy1 = nodes[edge[0]];
                double[] xy2 = nodes[edge[1]];
                g.DrawLine(Pens.Black, (int)Math.Round(xy1[0]), (int)Math.Round(xy1[1]),
                        (int)Math.Round(xy2[0]), (int)Math.Round(xy2[1]));
            }

            foreach (var node in nodes)
            {
                g.FillEllipse(Brushes.Black, (int)Math.Round(node[0]) - 4,
                    (int)Math.Round(node[1]) - 4, 8, 8);
            }
        }
    }
}


unit main;

interface

uses
  Winapi.Windows, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls,
  System.Math, System.Classes;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  nodes: TArray<TArray<double>> = [[-1, -1, -1], [-1, -1, 1], [-1, 1, -1], [-1,
    1, 1], [1, -1, -1], [1, -1, 1], [1, 1, -1], [1, 1, 1]];
  edges: TArray<TArray<Integer>> = [[0, 1], [1, 3], [3, 2], [2, 0], [4, 5], [5,
    7], [7, 6], [6, 4], [0, 4], [1, 5], [2, 6], [3, 7]];

implementation

{$R *.dfm}

procedure Scale(factor: TArray<double>);
begin
  if Length(factor) <> 3 then
    exit;
  for var i := 0 to High(nodes) do
    for var f := 0 to High(factor) do
      nodes[i][f] := nodes[i][f] * factor[f];
end;

procedure RotateCuboid(angleX, angleY: double);
begin
  var sinX := sin(angleX);
  var cosX := cos(angleX);
  var sinY := sin(angleY);
  var cosY := cos(angleY);

  for var i := 0 to High(nodes) do
  begin
    var x := nodes[i][0];
    var y := nodes[i][1];
    var z := nodes[i][2];

    nodes[i][0] := x * cosX - z * sinX;
    nodes[i][2] := z * cosX + x * sinX;

    z := nodes[i][2];

    nodes[i][1] := y * cosY - z * sinY;
    nodes[i][2] := z * cosY + y * sinY;
  end;
end;

function DrawCuboid(x, y, w, h: Integer): TBitmap;
var
  offset: TPoint;
begin
  Result := TBitmap.Create;
  Result.SetSize(w, h);
  rotateCuboid(PI / 180, 0);
  offset := TPoint.Create(x, y);
  with Result.canvas do
  begin
    Brush.Color := clBlack;
    Pen.Color := clWhite;

    Lock;
    FillRect(ClipRect);

    for var edge in edges do
    begin
      var p1 := (nodes[edge[0]]);
      var p2 := (nodes[edge[1]]);
      moveTo(trunc(p1[0]) + offset.x, trunc(p1[1]) + offset.y);
      lineTo(trunc(p2[0]) + offset.x, trunc(p2[1]) + offset.y);
    end;
    Unlock;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ClientHeight := 360;
  ClientWidth := 640;
  DoubleBuffered := true;
  scale([100, 100, 100]);
  rotateCuboid(PI / 4, ArcTan(sqrt(2)));
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
  buffer: TBitmap;
begin
  buffer := DrawCuboid(ClientWidth div 2, ClientHeight div 2, ClientWidth, ClientHeight);
  Canvas.Draw(0, 0, buffer);
  buffer.Free;
end;

end.


node[][] = [ [ -1 -1 -1 ] [ -1 -1 1 ] [ -1 1 -1 ] [ -1 1 1 ] [ 1 -1 -1 ] [ 1 -1 1 ] [ 1 1 -1 ] [ 1 1 1 ] ]
edge[][] = [ [ 0 1 ] [ 1 3 ] [ 3 2 ] [ 2 0 ] [ 4 5 ] [ 5 7 ] [ 7 6 ] [ 6 4 ] [ 0 4 ] [ 1 5 ] [ 2 6 ] [ 3 7 ] ]
#
func scale f . .
  for i range len node[][]
    for d range 3
      node[i][d] *= f
    .
  .
.
func rotate angx angy . .
  sinx = sin angx
  cosx = cos angx
  siny = sin angy
  cosy = cos angy
  for i range len node[][]
    x = node[i][0]
    z = node[i][2]
    node[i][0] = x * cosx - z * sinx
    y = node[i][1]
    z = z * cosx + x * sinx
    node[i][1] = y * cosy - z * siny
    node[i][2] = z * cosy + y * siny
  .
.
len nd[] 3
func draw . .
  clear
  m = 999
  mi = -1
  for i range len node[][]
    if node[i][2] < m
      m = node[i][2]
      mi = i
    .
  .
  ix = 0
  for i range len edge[][]
    if edge[i][0] = mi
      nd[ix] = edge[i][1]
      ix += 1
    elif edge[i][1] = mi
      nd[ix] = edge[i][0]
      ix += 1
    .
  .
  for ni range len nd[]
    for i range len edge[][]
      if edge[i][0] = nd[ni] or edge[i][1] = nd[ni]
        x1 = node[edge[i][0]][0]
        y1 = node[edge[i][0]][1]
        x2 = node[edge[i][1]][0]
        y2 = node[edge[i][1]][1]
        move x1 + 50 y1 + 50
        line x2 + 50 y2 + 50
      .
    .
  .
.
call scale 25
call rotate 45 atan sqrt 2
call draw
on animate
  call rotate 1 0
  call draw
.


#define PI 3.14159265358979323
#define SCALE 50
#define SIZE 320
#define zoff 0.5773502691896257645091487805019574556
#define cylr 1.6329931618554520654648560498039275946
screenres SIZE, SIZE, 4

dim as double theta = 0.0, dtheta = 1.5, x(0 to 5), lasttime, dt = 1./30

dim as double cylphi(0 to 5) = {PI/6, 5*PI/6, 3*PI/2, 11*PI/6, PI/2, 7*PI/6}

sub drawcube( x() as double, colour as uinteger )
    for i as uinteger = 0 to 2
        line (SIZE/2, SIZE/2-SCALE/zoff) - (x(i), SIZE/2-SCALE*zoff), colour
        line (SIZE/2, SIZE/2+SCALE/zoff) - (x(5-i), SIZE/2+SCALE*zoff), colour
        line ( x(i), SIZE/2-SCALE*zoff ) - ( x(i mod 3 + 3), SIZE/2+SCALE*zoff ), colour
        line ( x(i), SIZE/2-SCALE*zoff ) - ( x((i+1) mod 3 + 3), SIZE/2+SCALE*zoff ), colour
    next i
end sub

while inkey=""
    lasttime = timer
    for i as uinteger = 0 to 5
        x(i) = SIZE/2 + SCALE*cylr*cos(cylphi(i)+theta)
    next i
    drawcube x(), 15

    while timer < lasttime + dt
    wend
    theta += dtheta*(timer-lasttime)
    drawcube x(),0
wend
end


include "Tlbx agl.incl"
include "Tlbx glut.incl"

output file "Rotating Cube"

local fn AnimateCube
'~'1
begin globals
dim as double  sRotation
end globals

// Speed of rotation
sRotation += 2.9
glMatrixMode( _GLMODELVIEW )

glLoadIdentity()
glTranslated( 0.0, 0.0, 0.0 )
glRotated( sRotation, -0.45, -0.8, -0.6 )
glColor3d( 1.0, 0.0, 0.3 )
glLineWidth( 1.5 )
glutWireCube( 1.0 )
end fn

// Main program
dim as GLint           attrib(2)
dim as CGrafPtr        port
dim as AGLPixelFormat  fmt
dim as AGLContext      glContext
dim as EventRecord     ev
dim as GLboolean       yesOK

window 1, @"Rotating Cube", (0,0) - (500,500)

attrib(0) = _AGLRGBA
attrib(1) = _AGLDOUBLEBUFFER
attrib(2) = _AGLNONE

fmt = fn aglChoosePixelFormat( 0, 0, attrib(0) )
glContext = fn aglCreateContext( fmt, 0 )
aglDestroyPixelFormat( fmt )

port = window( _wndPort )
yesOK = fn aglSetDrawable( glContext, port )
yesOK = fn aglSetCurrentContext( glContext )

glClearColor( 0.0, 0.0, 0.0, 0.0 )

poke long event - 8, 1
do
glClear( _GLCOLORBUFFERBIT )
fn AnimateCube
aglSwapBuffers( glContext )
HandleEvents
until gFBQuit


package main

import (
	"image"
	"image/color"
	"image/gif"
	"log"
	"math"
	"os"
)

const (
	width, height = 640, 640
	offset        = height / 2
	fileName      = "rotatingCube.gif"
)

var nodes = [][]float64{{-100, -100, -100}, {-100, -100, 100}, {-100, 100, -100}, {-100, 100, 100},
	{100, -100, -100}, {100, -100, 100}, {100, 100, -100}, {100, 100, 100}}
var edges = [][]int{{0, 1}, {1, 3}, {3, 2}, {2, 0}, {4, 5}, {5, 7}, {7, 6},
	{6, 4}, {0, 4}, {1, 5}, {2, 6}, {3, 7}}

func main() {
	var images []*image.Paletted
	fgCol := color.RGBA{0xff, 0x00, 0xff, 0xff}
	var palette = []color.Color{color.RGBA{0x00, 0x00, 0x00, 0xff}, fgCol}
	var delays []int

	imgFile, err := os.Create(fileName)
	if err != nil {
		log.Fatal(err)
	}
	defer imgFile.Close()

	rotateCube(math.Pi/4, math.Atan(math.Sqrt(2)))
	var frame float64
	for frame = 0; frame < 360; frame++ {
		img := image.NewPaletted(image.Rect(0, 0, width, height), palette)
		images = append(images, img)
		delays = append(delays, 5)
		for _, edge := range edges {
			xy1 := nodes[edge[0]]
			xy2 := nodes[edge[1]]
			drawLine(int(xy1[0])+offset, int(xy1[1])+offset, int(xy2[0])+offset, int(xy2[1])+offset, img, fgCol)
		}
		rotateCube(math.Pi/180, 0)
	}
	if err := gif.EncodeAll(imgFile, &gif.GIF{Image: images, Delay: delays}); err != nil {
		imgFile.Close()
		log.Fatal(err)
	}

}

func rotateCube(angleX, angleY float64) {
	sinX := math.Sin(angleX)
	cosX := math.Cos(angleX)
	sinY := math.Sin(angleY)
	cosY := math.Cos(angleY)
	for _, node := range nodes {
		x := node[0]
		y := node[1]
		z := node[2]
		node[0] = x*cosX - z*sinX
		node[2] = z*cosX + x*sinX
		z = node[2]
		node[1] = y*cosY - z*sinY
		node[2] = z*cosY + y*sinY
	}
}

func drawLine(x0, y0, x1, y1 int, img *image.Paletted, col color.RGBA) {
	dx := abs(x1 - x0)
	dy := abs(y1 - y0)
	var sx, sy int = -1, -1
	if x0 < x1 {
		sx = 1
	}
	if y0 < y1 {
		sy = 1
	}
	err := dx - dy
	for {
		img.Set(x0, y0, col)
		if x0 == x1 && y0 == y1 {
			break
		}
		e2 := 2 * err
		if e2 > -dy {
			err -= dy
			x0 += sx
		}
		if e2 < dx {
			err += dx
			y0 += sy
		}
	}
}

func abs(x int) int {
	if x < 0 {
		return -x
	}
	return x
}